Format excel report needs performance improvement

Question

This is follow up question for another question- VBA Macro to format excel report needs performance improvement

I have a VBA macro which inserts a blank line to an excel whenever level column value in current row is not a consecutive number to the level value in previous row, another condition I use is if level in two consecutive rows is same then skip inserting blank line. Using the answer to that question I just added few lines and it had given perfect performance, but that code works only for 10K rows and if rows > 10K it does nothing, no error as well. I think it just gets data but does not paste transformed data. I have been debugging this from couple of days but not able to make it work. Any hint/help will be really appreciated. Below is the vba I am using:

Private Sub Workbook_Open()
    CarryOn = MsgBox("Do you want to run a macro that will format the report?", vbYesNo, "Report Formatting Automation")
    If CarryOn = vbYes Then
     'Backup report
    Sheets("Where Used Report").Copy after:=Sheets("Where Used Report")
    ActiveSheet.Name = "Original Where Used Report"
    Sheets("Where Used Report").Activate

    Dim i As Long, j As Long, r As Long
    Dim arrData, arrRes, lastRow, ColCnt As Long
    Dim a, b, c As Long
    Dim numCheck
    
    'macro on open file event
    If Cells(1, 4).Value = "1" Then
    'do not run open macro if already run once
    Else
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    arrData = Range("A6:S" & lastRow).Value
    ColCnt = UBound(arrData, 2)
    ReDim arrRes(1 To UBound(arrData) * 2, 1 To ColCnt)
    r = 1
    For j = 1 To ColCnt
        arrRes(r, j) = arrData(1, j)
    Next j
    MsgBox LBound(arrData)
    MsgBox UBound(arrData)
    For i = LBound(arrData) + 1 To UBound(arrData)
    a = arrData(i, 1)
    b = arrData(i - 1, 1)
    
    numCheck = IsNumeric(b)
    
    If numCheck = True Then
    c = arrData(i - 1, 1) + 1
    Else
   'No where used component
   GoTo Last
   End If
        If a = b Or a = c Then
           'MsgBox "No line break"
            r = r + 1
        Else
            'MsgBox "Need a line break"
            r = r + 2
        End If
        
        For j = 1 To ColCnt
            arrRes(r, j) = arrData(i, j)
        Next j
    Next i
        'MsgBox "Copy start"
        Range("C5:C" & r).NumberFormat = "0000"
        Range("A6").Resize(r, ColCnt).Value = arrRes
        'MsgBox "Copy Complete"
        Cells(1, 4).Value = "1"  
   End If   
   Else
   ' MsgBox ("Report format is to be kept same."
End If
Last:
Cells(1, 4).Value = "1"
End Sub```

Answer 1

• If a cell contains non-numeric content, the code will proceed to the Last: section, and the table update code will be skipped.

---

• If you opt for using Goto, ensure you include an Exit Sub before Last:. Without it, regardless of whether numCheck is True or False, the Last: section will be executed.

• Adding code to update cell D1 with different values can be useful for identifying issues with the data.

Private Sub Workbook_Open()
    ' ...
                If numCheck = True Then
                    c = arrData(i - 1, 1) + 1
                Else
                    'No where used component
                    GoTo Last
                End If
                ' ...
    Else
        ' MsgBox ("Report format is to be kept same."
    End If
    Exit Sub
Last:
    Cells(1, 4).Value = "Error on row" & i-1
End Sub

---

• I would recommend avoiding the use of Goto, as illustrated below.

Private Sub Workbook_Open()
    ' ...
                If numCheck = True Then
                    c = arrData(i - 1, 1) + 1
                Else
                    'No where used component
                    Cells(1, 4).Value = "Error on row" & i-1
                    Exit Sub
                End If
   '...
    Else
        ' MsgBox ("Report format is to be kept same."
    End If
End Sub