Excel - Extremely Slow Loop Macro - vba

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.

Answer 1

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)