Integer not storing correct LastRow value after many loops: VBA Run-Time error

Question

In the code below, my LastRow variable is not storing the right row number on the 27th loop (i = 27) causing the code to malfunction

I have used the F8 step through multiple times and noticed that the issue is on the 27th loop. The LastRow variable is meant to be +1204 rows from the previous LastRow value on each iteration of the loop, so I was expecting LastRow = 32509 instead of LastRow = 31316. For reference, on the 26th loop, LastRow = 31305. I'm not sure why the it is finding the wrong LastRow when the code has worked for the first 26 loops.

I am trying to get from my Source Table to my Desired Table:

Source Table

to

Desired Table

Also , the final error that shows is:

Run-Time error '1004': Application -defined or object- defined error

Sub Populate_entity()        
Dim i As Integer    
i = 1    
Dim LastRow  As Long
Dim SearchText As String   

Do While i < 122 ' go across entity (columns wise)    
    If i = 1 Then   
        Range("E1").Select    
        Selection.Copy                                 
        SearchText = ActiveCell.Value
        ActiveCell.End(xlToLeft).Select                 'snap to left (cell A1)
        ActiveCell.Offset(0, 2).Select                  'move to cell C1
        ActiveCell.Offset(1, 0).Select                   ' move to cell C2
    Else            
        ActiveCell.Offset(0, i + 1).Select    
        Selection.Copy
        SearchText = ActiveCell.Value
        ActiveCell.End(xlToLeft).Select
        ActiveCell.Offset(0, 2).Select
        ActiveCell.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select            
    End If                
    ActiveSheet.Paste
    ActiveCell.Offset(1203, 0).Select        
    ActiveSheet.Paste
    ActiveCell.End(xlUp).Select
    ' ======== Error here ========
    LastRow = Cells.Find(What:=SearchText, After:=ActiveCell, LookIn:=xlValues, SearchOrder:=xlByRows).Row
    Range("C" & ActiveCell.Row & ":C" & LastRow).FillDown
    ActiveCell.End(xlUp).Select       
    i = i + 1    
Loop    
End Sub

Answer 1

In my opinion you don't need any search because your code always places the SearchString in row 1205. Since you know that it is there you don't need to look for it. This thought brings me to the code below.

Sub Populate_Entity()

    Dim C As Long                                   ' Column
    Dim Target As Range
    Dim FirstRow As Long
    Dim LastRow  As Long

    FirstRow = 2
    LastRow = 7     '1205
    C = 3
    Range("C2").value = Range("E1").value
    ' Cells(2, C).Value = Cells(1, 5).Value

    Do
        Set Target = Range(Cells(FirstRow, C), Cells(LastRow, C))
        Target.FillDown

        C = C + 1
        Cells(2, C).value = "Can't figure"

    Loop While C < 3    ' 122

End Sub

I have cut the loop short to only 7 rows (instead of 1205) and 3 columns (instead of 122). I just couldn't figure out where the text in the FirstRow should come from. For column C it comes from E1, but where does it come from in the subsequent columns? You can fill this in using the method I showed you above, like, Cells(2, C).Value = Cells(1, 5).Value. I believe that the 5 can be replaced by a value derived from the current C, perhaps C + 2.

Note the Cells(2, C).Value doesn't refer to the value in cell C2. Instead if refers to the cell in Row 2, Column C.

Answer 2

A summary of what you want, as you described in the comments:

Copy the values from cells E1:DU1, paste each cell 1204 times in column C.

• 1st loop it will paste cell E1 in C2:C1205
• 2nd loop it will paste cell F1 to C1206:C2409
• etc.

This code achieves that:

Sub Populate_entity()

    ' Declare 2 range variables (top row to copy from and paste destination)
    Dim RowRange As Range
    Dim PasteCells As Range
    ' Use the With block to specify the sheet. If you want the destination
    ' to be another sheet, then you can specify that instead: 
    ' ThisWorkbook.Sheets("SheetName").Range("...") 
    With ThisWorkbook.ActiveSheet
        Set RowRange = .Range("E1:DU1")     ' Set range to copy from
        Set PasteCells = .Range("C2:C1205") ' Set paste cells, blocks of 1204 cells in column C
    End With
    ' Loop through RowRange, copy each cell's value into PasteCells
    ' Then offset the PasteCells range by 1024 rows, so next RowRange cell
    ' is inserted underneath previously copied cells.
    Dim ofst As Long
    For ofst = 1 To RowRange.Cells.Count
        ' Use .Value to avoid the (comparably slow) copy/paste operation 
        PasteCells.Offset((ofst - 1) * 1204, 0).Value = RowRange.Cells(ofst).Value
    Next ofst

End Sub