Excel VBA Debugging - excel

Question

I'm running into a "run time error 1004". I suspect this has something to do with how much data I want my code to process. Currently I am running a 246 column by 30,000 row. What I'm trying to achieve is to consolidate my data into one row item because the current system export the data into individual row as a duplicate for certain data columns. As a result, the data has a ladder/stagger effect where there's duplicate row ID with blank cells in one and data below it.
Example:
Code:
Option Explicit
Sub consolidate()
Const SHEET_NAME = "Archer Search Report"
Const NO_OF_COLS = 101
Dim wb As Workbook, ws As Worksheet
Dim irow As Long, iLastRow As Long, c As Long, count As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets(SHEET_NAME)
iLastRow = ws.Range("A" & Rows.count).End(xlUp).Row
' scan up sheet
For irow = iLastRow - 1 To 2 Step -1
' if same id below
If ws.Cells(irow + 1, 1) = ws.Cells(irow, 1) Then
' scan across
For c = 1 To NO_OF_COLS
' if blank copy from below
If Len(ws.Cells(irow, c)) = 0 Then
ws.Cells(irow, c) = ws.Cells(irow + 1, c)
End If
Next
ws.Rows(irow + 1).Delete
count = count + 1
End If
Next
MsgBox iLastRow - 1 & " rows scanned" & vbCr & _
count & " rows deleted from " & ws.Name, vbInformation
End Sub
I suspect it has to do with the massive amount of data it's running and wanted to see if that is the case. If so, is there an alternative approach? Appreciate the assistance.
Note: I got this awesome code from someone(CDP1802)here and have been using it for years with smaller data set.

Answer 1

Here's a slightly different approach which does not require sorting by id, includes some checking for error values, and does not overwrite any data in the output.
Sub consolidate()
Const SHEET_NAME = "Archer Search Report"
Const NO_OF_COLS = 10 'for example
Dim wb As Workbook, ws As Worksheet, dataIn, dataOut
Dim i As Long, c As Long
Dim dict As Object, id, rwOut As Long, idRow As Long, vIn, vOut, rngData As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets(SHEET_NAME)
Set dict = CreateObject("scripting.dictionary")
Set rngData = ws.Range("A2:A" & ws.Cells(ws.Rows.count, 1).End(xlUp).Row).Resize(, NO_OF_COLS)
dataIn = rngData.Value 'input data as 2D array
ReDim dataOut(1 To UBound(dataIn, 1), 1 To NO_OF_COLS) 'resize "out" to match "in" array size
rwOut = 0 'row counter for "out" array
For i = 1 To UBound(dataIn, 1)
id = dataIn(i, 1) 'id for this "row"
If Not dict.exists(id) Then
'not seen this id before
rwOut = rwOut + 1
dict(id) = rwOut 'add id and row to dictionary
dataOut(rwOut, 1) = id 'add id to "out" array
End If
idRow = dict(id) 'row locator in the "out" array
For c = 2 To NO_OF_COLS
vIn = dataIn(i, c) 'incoming value
vOut = dataOut(idRow, c) 'existing value
'ignore error values, and don't overwrite any existing value in the "out" array
If Not IsError(vIn) Then
If Len(vIn) > 0 And Len(vOut) = 0 Then dataOut(idRow, c) = vIn
End If
Next c
Next i
rngData.Value = dataOut 'replace input data with output array
MsgBox "Got " & rwOut & " unique rows from " & UBound(dataIn, 1)
End Sub