How to copy 500 cell value in a loop and run it untill it reaches the last cell

Question

i am trying to build a vba program in which i have 3 worksheets : sheet 1, sheet2 and sheet3, i will input the data in sheet 2 (column A : column E) and i want to copy first 500 rics to be copied from sheet 2 (column B) in sheet 1 (column A) and what ever the result comes based on refinitv formula in sheet 1 (column D : column G) should get copied to sheet 3 , then again the macro should go to sheet 2 copy the next 500 rics then paste it in sheet 1 column A and what ever the result comes should get pasted in sheet 3, this process should run untill all the rics are covered in sheet 2. for example if sheet 2 has total of 1200 rics then the loop will run thrice (500 + 500+ 200 = 1200). the only help i need is in the for loop section rest i will try on my own.

rewriting the sequence for better understanding: sheet 2 : i will input the data, the macro should should pick first 500 rics from column B and paste those in sheet 1 , column (A2) then the eikon formula will fetch the result based on column A and macro should copy the result in sheet 3 then again the next 500 rics from sheet 2 gets picked and the same process should be followed.

Sub CAEvents()
Application.ScreenUpdating = False

    Dim wb As Workbook, ws As Worksheet, wsRic As Worksheet, ws1 As Worksheet
    Dim iLastRow As Long, r As Long, n As Long, i As Integer
    Dim ric As String

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    Set ws1 = wb.sheeets("Sheet2") ' as appropriate
    'n = ws.Range("B2").Value ' days
    
    ThisWorkbook.Sheets("Sheet1").Range("A2:E50000").ClearContents
    'ThisWorkbook.Sheets("Output").Cells.ClearContents
    'ThisWorkbook.Sheets("InsertSeveralSpots").Range("B6:F6").End(xlDown).clearcontent

    ' loop through rics in col I
    iLastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
    If iLastRow >= 2 Then
        For r = 2 To iLastRow
            ric = ws.Cells(r, "I")
            ws.Range("A2").Value2 = ric
            
             ws.Range("C1").FormulaR1C1 = "=@RHistory(R2C1,"".Timestamp;.Close"",""NBROWS:""&R2C2&"" INTERVAL:1D"",,""SORT:ASC TSREPEAT:NO CH:In;fd"",R[5]C)"
            
            Application.Run "EikonRefreshWorksheet"
            
            Application.Wait (Now + TimeValue("0:00:02"))

I am struggling to understand your question, but it looks difficult... You say something in words and the piece of code you show does not try doing what you say. You did not say anything about copying a value from I:I column of the same "Sheet1" sheet in "A2" and write a formula in "C1" as many time as `iLastRow` from "Sheet2" is... Can you better explain what you want? I am afraid, nobody can help just reading the question as it is formulated... — FaneDuru, Aug 01 '21 at 16:47
rewriting the sequence for better understanding: sheet 2 : i will input the data, the macro should should pick first 500 rics from column B and paste those in sheet 1 , column (A2) then the eikon formula will fetch the result based on column A and macro should copy the result in sheet 3 then again the next 500 rics from sheet 2 gets picked and the same process should be followed. — Naina, Aug 02 '21 at 06:16
Should the code write the eikon formula, or it is already on the sheet? If necessary to write it **where to be written**? What the sub "EikonRefreshWorksheet" will do, except calculating the sheet? — FaneDuru, Aug 02 '21 at 06:42
the code write the formula, and it should be written in Sheet1(cellD2) and eikonrefreshworksheet only calcualte the sheet nothing else. — Naina, Aug 02 '21 at 06:50
yes the code write the formula in cell D2 , formula has it own range FormulaR1C1 = "=@RHistory("A2:A1000","".Timestamp;.Close"",""NBROWS:""&R2C2&"" INTERVAL:1D"",,""SORT:ASC TSREPEAT:NO CH:In;fd"",R[5]C)" based on the range it checks the data for the mentioned range and share the putput in column (D:E) — Naina, Aug 02 '21 at 07:29
OK. I will try preparing an answer. But you did not answer my clarification question regarding "EikonRefreshWorksheet"... — FaneDuru, Aug 02 '21 at 08:23
eikonrefreshworksheet only calcualte the sheet nothing else, it like a refresh button — Naina, Aug 02 '21 at 08:29
Didn't find some time to test the code I posted? Not being tested, even if I think that is logic is OK, I would need some feedback. If it works well or if not, what error, on which row, what it does against what is should do according to your needs... — FaneDuru, Aug 02 '21 at 11:00

FaneDuru · Answer 1 · 2021-08-03T13:45:25.317

1

Please, test the next code. It is not tested, not having a test file, but it should work. Please, send some feedback after testing it:

Sub Copy500Rows()
   Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lastR2 As Long, lastRA As Long
   Dim lastR3 As Long, lastR As Long, arr2, arrDG, i As Long, noIt As Long, lastNr As Long
   
   Set sh1 = Worksheets("Sheet1") 'use here your necessary sheet
   Set sh2 = Worksheets("Sheet2") 'use here your necessary sheet
   Set sh3 = Worksheets("Sheet3") 'use here your necessary sheet
   lastR2 = sh2.Range("B" & sh2.rows.count).End(xlUp).row 'last row of B:B in sheet2
   
   lastR = 500              'the slices to be used
   noIt = Int(lastR2 / lastR)  'number of necesssary iterations
   'calculate the reall necessary number of iterations and the last iteration number of rows
   If lastR2 / lastR > noIt Then
      If noIt > 0 Then
          lastNr = lastR2 - noIt * lastR
          noIt = noIt + 1
      Else
         lastR = lastR2: noIt = 1
      End If
   ElseIf lastR2 / lastR < noIt Then
      lastR = lastR2: noIt = 1
   End If
   sh1.Range("A2:A" & sh1.Range("A" & sh1.rows.count).End(xlUp).row).ClearContents
   sh3.Range("D2:G" & sh3.Range("D" & sh3.rows.count).End(xlUp).row).ClearContents
   'put the formula:
   sh1.Range("D2").FormulaR1C1 = "=@RHistory(R2C1,"".Timestamp;.Close"",""NBROWS:""&R2C2&"" INTERVAL:1D"",,""SORT:ASC TSREPEAT:NO CH:In;fd"",R[5]C)"
   For i = 1 To noIt
        arr2 = sh2.Range("B" & IIf(i = 1, 2, (lastR + 1) * (i - 1)) & ":B" & (lastR + 1) * i).value 'put the range in an array to make the code faster
        lastRA = sh1.Range("A" & sh1.rows.count).End(xlUp).row + 1 'last empty row of A:A in sheet1
        sh1.Range("A" & lastRA).Resize(UBound(arr2), 1).value = arr2 'drop the array content in the last empty row of sheet1
        
        sh1.Calculate   'calculate

        arrDG = sh1.Range("D2:G" & sh1.Range("D" & sh1.rows.count).End(xlUp).row).value   'put the range in an array
        lastR3 = sh3.Range("D" & sh3.rows.count).End(xlUp).row + 1                                         'last empty row of D:D in sheet3
        'drop the array content:
        sh3.Range("D" & lastR3).Resize(UBound(arrDG), UBound(arrDG, 2)).value = arrDG
        If i = noIt - 1 And lastNr > 0 Then lastR = lastNr
   Next i
   MsgBox "Ready..."
End Sub

edited Aug 03 '21 at 13:45

answered Aug 02 '21 at 09:12

FaneDuru

38,298
4
19
27

sh1.Range("A" & lastRA).Resize(1, UBound(arr2)).Value = arr2 'drop the array content in the last empty row of sheet1 getting error in this line – Naina Aug 02 '21 at 12:36
Application defined or object defined error – Naina Aug 02 '21 at 12:39
@ Naina Did you propperly set `sh1`? If you move the cursor over `sh`, when stopped on error, what do you see? When you move the cursor over `lastRA` what does it show? Do you have `Option Explicit` on top of the module where this code runs? – FaneDuru Aug 02 '21 at 12:57
LastRA = 57 and yes i have option explicit on top of the module – Naina Aug 02 '21 at 13:03
lastR = 500, lastR2= 19314, noIt = 19314/500 = 39 – Naina Aug 02 '21 at 13:04
Set sh1 = Worksheets("Sheet1") – Naina Aug 02 '21 at 13:06
@ Naina What `Ubound(arr2)` shows in the same circumstances? It looks it is a problem in building the range to load `arr2` array. In the way it is built it will always copy the first 500 rows, not incrementing the range after each iteration. If not confidential, can you share the workbook you work to? It is difficult to make a perfect code without testing... – FaneDuru Aug 02 '21 at 13:06
@ Naina Is it necessary to copy the formula at each iteration? – FaneDuru Aug 02 '21 at 13:16
Let us [continue this discussion in chat](https://chat.stackoverflow.com/rooms/235539/discussion-between-naina-and-faneduru). – Naina Aug 02 '21 at 13:19
@ Naina Since you do not answer the clarification questions, I updated the code to return as many rows exists in Sheet1 D:G columns, which looks more logic for me. Please, test it and send some feedback. – FaneDuru Aug 03 '21 at 13:52
hey i replied to you on chat – Naina Aug 03 '21 at 17:50
@ Naina No notification are received from chat room... I asked (there) for the same clarification... – FaneDuru Aug 03 '21 at 18:25
sorry for replying late, finally after some adjustments in the code, it worked – Naina Aug 20 '21 at 06:55
@ Naina What adjustments? Were they necessary according to the question, or you missed something when asking? I would like to adapt the above code according to the need. If somebody else will search for a similar issue, I would like the code to be working. Our main goal here is to make as many people as possible learning... – FaneDuru Aug 20 '21 at 06:59
i made some adjustment as per my requirement – Naina Aug 21 '21 at 13:44
@Naina If confused before, now I am more confused... But, no problem if you do not want to be clearer. You have a place on my list with users to not be helped in the future. – FaneDuru Aug 21 '21 at 13:47
@Naina Not a matter of grudges. On my tase, only a matter of disrespect. But no sense to discuss, anymore. Have a nice day! – FaneDuru Aug 21 '21 at 14:15

How to copy 500 cell value in a loop and run it untill it reaches the last cell

1 Answers1