Runtime Error 1004: application defined or object defined error

Question

I am currently facing above error when running vba as below(vba newbie here). Would you please see what is causing this error? I am using this script to parse information from a text file in excel with around 65000 rows. When I click 'debug' , it highlighted this row

If Cells(i, 2).Value = "Type: Error" And Cells(i + 5, 2).Value = " STATUS           : FAILURE" Then"

Thank you.

Sub color()
Dim i As Long
Dim j As Long
j = 0
ActiveSheet.Name = "Raw data"
sheets.Add.Name = "Error"
Range("A1:B1").Value = Array("DN", "Error details")
Worksheets("Raw data").Activate
For i = 1 To Rows.Count
If Cells(i, 2).Value = "Type: Error" And Cells(i + 5, 2).Value = " STATUS           : FAILURE" Then
    ActiveSheet.Cells(i, 2).Select
    ActiveCell.Offset(-1, 0).Copy
    Worksheets("Error").Range("A2").Offset(j, 0).PasteSpecial xlPasteAll
    ActiveCell.Offset(6, 0).Copy
    Worksheets("Error").Range("B2").Offset(j, 0).PasteSpecial xlPasteAll
    j = j + 1
    ElseIf Cells(i, 2).Value = "Type: Error" And Cells(i + 4, 2).Value = "Caused by ConnectException: Connection timed out" Then
    ActiveSheet.Cells(i, 2).Select
    ActiveCell.Offset(-1, 0).Copy
    Worksheets("Error").Range("A2").Offset(j, 0).PasteSpecial xlPasteAll
    ActiveCell.Offset(3, 0).Copy
    Worksheets("Error").Range("B2").Offset(j, 0).PasteSpecial xlPasteAll
    j = j + 1
  
End If
Next i
End Sub

@freeflow , I added the debug.Print Rows.count but how do I check the results of this? When I ran, still encountered the error and when i click debug button, the same line highlighted in original post lit up. Thanks. — Ong, Dec 11 '21 at 05:36
@braX I already edited the main post with the information you requested. Thanks. — Ong, Dec 11 '21 at 05:37
if you look at the value of `i` when you get the error, is it `1048572`? Your code adds `5` to that and gets `1048577`, and Excel has a limit of `1048576` rows. That's why it errors. — braX, Dec 11 '21 at 05:44
Instead of using `Rows.Count` (which does not represent rows with data) find the last row like this: https://stackoverflow.com/questions/38882321/better-way-to-find-last-used-row and use that to control your loop instead. — braX, Dec 11 '21 at 05:49
**1.** You know you do not need to use loops for this? Use Autofilter and copy the data directly as shown in [How to copy a line in excel using a specific word and pasting to another excel sheet?](https://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s) **2.** [Another way to find last row](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba) — Siddharth Rout, Dec 11 '21 at 08:27
You would need to comment out the if statement. I was just trying to get you to realise that you had made an assumption about the number of rows you were processing (as has been pointed out by others). But I was trying to do it without actually telling you the specific problem. — freeflow, Dec 11 '21 at 12:23

score 0 · Answer 1 · answered Dec 11 '21 at 12:09

As an alternative to iterating all the rows use Find and FindNext.

Option Explicit

Sub colorError()

    Dim wsErr As Worksheet, wsData As Worksheet
    Dim fnd As Range, first As String
    Dim j As Long, x As Long, y As Long, c As Long
    
    ' data
    Set wsData = ActiveSheet ' or Sheets(1)
    wsData.Name = "Raw Data"
    
    ' error sheet
    Set wsErr = Sheets.Add(after:=Sheets(Sheets.Count))
    wsErr.Name = "Error" & Sheets.Count
    wsErr.Range("A1:B1").Value2 = Array("DN", "Error details")
    j = 1
     
    Application.ScreenUpdating = False
    wsData.Activate
    ' scan raw data column B
    With wsData.Columns(2)
        Set fnd = .Find("Type: Error", lookat:=xlWhole, LookIn:=xlValues, MatchCase:=False)
        If Not fnd Is Nothing Then
            first = fnd.Address
            Do
                fnd.Interior.color = vbYellow
                x = 0
                If Application.Trim(fnd.Offset(5)) = "STATUS : FAILURE" Then
                     x = 6 ' offset to copy
                     y = 5
                     c = RGB(255, 200, 200) ' pink
                ElseIf Trim(fnd.Offset(4)) = _
                    "Caused by ConnectException: Connection timed out" Then
                     x = 3 ' offset to copy
                     y = 4
                     c = RGB(255, 200, 0) ' orange
                End If
            
                 ' copy to errors
                 If x > 0 Then
                     j = j + 1
                     fnd.Offset(-1).Copy wsErr.Cells(j, "A")
                     fnd.Offset(x).Copy wsErr.Cells(j, "B")
                     ' color raw data
                     fnd.Offset(x).Interior.color = c
                     fnd.Offset(y).Interior.color = vbYellow
                 End If
            
                 Set fnd = .FindNext(fnd)
                 If fnd.Row + 6 > wsData.Rows.Count Then
                     MsgBox "Aborted at row " & fnd.Row, vbCritical, "End of Sheet"
                     Exit Do
                 End If
                 
            Loop While fnd.Address <> first
        End If
    End With
    Application.ScreenUpdating = True

    MsgBox j - 1 & " rows written to " & wsErr.Name, vbInformation
    
End Sub

Thank you @CDP1802 for your useful answer. I have quickly ran this code and it looks ok. Will try to study it. Thank you again. — Ong, Dec 16 '21 at 06:40

Runtime Error 1004: application defined or object defined error

1 Answers1