Excel - Extremely Slow Loop Macro

Question

Sub listClean()

For Each cellA In Range("A:A")

    If cellA.Value <> "" Then

        For Each cellB In Range("B:B")

            If cellB.Value <> "" Then

                If StrComp(cellA.Value, cellB.Value) = 0 Then

                    cellA.Value = ""

                End If

            End If

        Next

    End If

Next

MsgBox "Macro Finished"

End Sub

The code basically removes from Range A:A whatever is in range B:B. Is there anything I can do to speed up this macro? I was thinking VBA could have a way to make ranges into arrays, and then clean the arrays.

Find the last row in Column A so you are not looping 1+ million times. Then use find or Application.Match to check if in Column B saving another loop. Currently you are looping 1.04Million^2 times. You need to limit the Loops to a minimum. — Scott Craner
– Scott Craner, Commented Oct 24, 2017 at 22:16
@ScottCraner Actually, it is only doing about (1 million * number of non-blanks in column A) + (number of blanks in column A) processes, so likely much, much smaller than 1,000,000,000,000 - but still way too many. — YowE3K
– YowE3K, Commented Oct 24, 2017 at 22:26

Scott Craner · Accepted Answer · 2017-10-25 12:40:37Z

3

This should be very quick.

It uses arrays instead of looping through the ranges.

Sub listClean()

Dim i As Long, t As Long, mtch As Long
Dim aClm() As Variant, bClm() As Variant
Dim outArr() As Variant

ReDim outArr(1 To 1) As Variant

With ActiveSheet
    'Load the arrays
    aClm = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
    bClm = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp)).Value
    t = 0
    For i = 1 To UBound(aClm, 1)
        mtch = 0
        'Search for match. If no match found it will error and stay at 0
        On Error Resume Next
            mtch = Application.WorksheetFunction.Match(aClm(i, 1), bClm, 0)
        On Error GoTo 0
        'Test whether match was found.
        If mtch = 0 Then
            t = t + 1
            'make output array bigger.
            ReDim Preserve outArr(1 To t) As Variant
            'Load value into last spot in output array
            outArr(t) = aClm(i, 1)
        End If

    Next i
    'Assign values to range from array.
    .Range("C1").Resize(UBound(outArr, 1), 1).Value = Application.Transpose(outArr)
End With


MsgBox "Macro Finished"

End Sub

It does put the output in column C. If you want to put it in column A then change,

.Range("C1").Resize(UBound(outArr, 1), 1).Value = Application.Transpose(outArr)

to:

.Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).ClearContents
.Range("A1").Resize(UBound(outArr, 1), 1).Value = Application.Transpose(outArr)

edited Oct 25, 2017 at 12:40

answered Oct 24, 2017 at 22:39

Scott Craner

153k10 gold badges52 silver badges88 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

user3704920 Over a year ago

@scott craner its incredibly fast. I have to learn a lot more about about the commands you used, seems complex. Thank you very much.

Collectives™ on Stack Overflow

Excel - Extremely Slow Loop Macro

1 Answer 1

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related