2

I am using the code that I was helped with in this previous question: (VBA Excel find and replace WITHOUT replacing items already replaced)

I have the following code that I use to replace items in a column: Sub Replace_Once() Application.ScreenUpdating = False

LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:A" & LastRow).Interior.ColorIndex = xlNone
    For Each Cel In Range("B1:B" & LastRow)
        For Each C In Range("A1:A" & LastRow)
            If C.Value = Cel.Value And C.Interior.Color <> RGB(200, 200, 200) Then
            C.Interior.Color = RGB(200, 200, 200)
            C.Value = Cel.Offset(0, 1).Value
        End If
    Next
Next

Which works fine for small files, but when column A approaches 3800 in length and B and C are about 280 Excel crashes and I get the following error:

Run-time error '-2147417848 (800810108)':

Method 'Color' of object "Interior' failed

Any ideas why this could be happening?

EDIT: Just to clarify the error seems to happen in the line

If C.Value = Cel.Value And C.Interior.Color = RGB(200, 200, 200) Then
Tim Stack
  • 3,209
  • 3
  • 18
  • 39
curious-cat
  • 421
  • 1
  • 7
  • 17
  • I ran your code using 10 as the number for LastRow and it ran without issue. Put some error trapping in to get the full error – Sorceri Oct 17 '13 at 22:24
  • It runs fine with 10 as the number for LastRow, but the error starts appearing when the number approaches 3800 – curious-cat Oct 17 '13 at 22:26
  • I ran it to 4000 and it went fine. probably an issue with the workbook. Copy the data into notepad and than back into excel. Rerun the macro. if that fails try manually setting the color of the cell using the GUI. Did you trap the error? Example: On error goto captureError captureError: if Err.Number > 0 then msgbox Err.Description – Sorceri Oct 17 '13 at 22:46
  • I am trying to capture the error. Often excel just crashes and it's kind of tricky to do. I will try copying the data into notepad and pasting it back. – curious-cat Oct 17 '13 at 22:56

1 Answers1

2

I did few optimization to your code.

  1. Declared the variables/objects
  2. Reduced your loop time. Earlier your code was looping 201924100 times (14210 Col A Rows X 14210 Col B Rows). You didn't have to do that because B236 onwards is empty. Now the loop runs only 3339350 times. (14210 Col A Rows X 235 Col B Rows)
  3. The entire code finished in 1 Min 53 Seconds. See Output in Immediate window at the end of the post.

Try this. This worked for me. Tested it in Excel 2013.

Sub Replace()
    Dim ws As Worksheet
    Dim A_LRow As Long, B_LRow As Long
    Dim i As Long, j As Long

    Application.ScreenUpdating = False

    Debug.Print "process started at " & Now

    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Get Col A Last Row
        A_LRow = .Range("A" & .Rows.Count).End(xlUp).Row
        '~~> Get Col B Last Row
        B_LRow = .Range("B" & .Rows.Count).End(xlUp).Row

        .Range("A1:A" & A_LRow).Interior.ColorIndex = xlNone

        For i = 2 To B_LRow
            For j = 2 To A_LRow
                If .Range("A" & j).Value = .Range("B" & i).Value And _
                .Range("A" & j).Interior.Color <> RGB(200, 200, 200) Then
                    .Range("A" & j).Interior.Color = RGB(200, 200, 200)
                    .Range("A" & j).Value = .Range("B" & i).Offset(0, 1).Value
                    DoEvents
                End If
            Next j
        Next i
    End With

    Application.ScreenUpdating = True

    Debug.Print "process ended at " & Now
End Sub

Output in Immediate window

process started at 10/18/2013 6:29:55 AM
process ended at 10/18/2013 6:31:48 AM
Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
  • This is excellent! Would you mind explaining a little bit what is happening in this script? (or at least, why it's more optimized other than the reduction in lines it processes?) – curious-cat Oct 18 '13 at 03:32
  • But I already did that ;) Please see the 3 points that I mentioned in the beginning of the post. – Siddharth Rout Oct 18 '13 at 03:33