Fast compare method of 2 columns [closed]
Ok. Let's clarify a few things.
So column A has 10,000 randomly generated values , column I has 5000 randomly generated values. It looks like this
I have run 3 different codes against 10,000 cells.
the for i = 1 to ... for j = 1 to ... approach, the one you are suggesting
Sub ForLoop()
Application.ScreenUpdating = False
Dim stNow As Date
stNow = Now
Dim lastA As Long
lastA = Range("A" & Rows.Count).End(xlUp).Row
Dim lastB As Long
lastB = Range("I" & Rows.Count).End(xlUp).Row
Dim match As Boolean
Dim i As Long, j As Long
Dim r1 As Range, r2 As Range
For i = 2 To lastA
Set r1 = Range("A" & i)
match = False
For j = 3 To lastB
Set r2 = Range("I" & j)
If r1 = r2 Then
match = True
End If
Next j
If Not match Then
Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1) = r1
End If
Next i
Debug.Print DateDiff("s", stNow, Now)
Application.ScreenUpdating = True
End Sub
Sid's appraoch
Sub Sample()
Dim wsDes As Worksheet, wsSrc As Worksheet
Dim rngDes As Range, rngSrc As Range
Dim DesLRow As Long, SrcLRow As Long
Dim i As Long, j As Long, n As Long
Dim DesArray, SrcArray, TempAr() As String
Dim boolFound As Boolean
Set wsDes = ThisWorkbook.Sheets("Sheet1")
Set wsSrc = ThisWorkbook.Sheets("Sheet2")
DesLRow = wsDes.Cells(Rows.Count, 1).End(xlUp).Row
SrcLRow = wsSrc.Cells(Rows.Count, 1).End(xlUp).Row
Set rngDes = wsDes.Range("A2:A" & DesLRow)
Set rngSrc = wsSrc.Range("I3:I" & SrcLRow)
DesArray = rngDes.Value
SrcArray = rngSrc.Value
For i = LBound(SrcArray) To UBound(SrcArray)
For j = LBound(DesArray) To UBound(DesArray)
If SrcArray(i, 1) = DesArray(j, 1) Then
boolFound = True
Exit For
End If
Next j
If boolFound = False Then
ReDim Preserve TempAr(n)
TempAr(n) = SrcArray(i, 1)
n = n + 1
Else
boolFound = False
End If
Next i
wsDes.Cells(DesLRow + 1, 1).Resize(UBound(TempAr) + 1, 1).Value = _
Application.Transpose(TempAr)
End Sub
my (mehow) approach
Sub Main()
Application.ScreenUpdating = False
Dim stNow As Date
stNow = Now
Dim arr As Variant
arr = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
Dim varr As Variant
varr = Range("I3:I" & Range("I" & Rows.Count).End(xlUp).Row).Value
Dim x, y, match As Boolean
For Each x In arr
match = False
For Each y In varr
If x = y Then match = True
Next y
If Not match Then
Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1) = x
End If
Next
Debug.Print DateDiff("s", stNow, Now)
Application.ScreenUpdating = True
End Sub
the results as follows
now, you select the fast compare method :)
filling in of the random values
Sub FillRandom()
Cells.ClearContents
Range("A1") = "Column A"
Range("I2") = "Column I"
Dim i As Long
For i = 2 To 10002
Range("A" & i) = Int((10002 - 2 + 1) * Rnd + 2)
If i < 5000 Then
Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1) = _
Int((10002 - 2 + 1) * Rnd + 2)
End If
Next i
End Sub
Here is non-looping code that executes almost instantly for the example given above from mehow.
Sub HTH()
Application.ScreenUpdating = False
With Range("A2", Cells(Rows.Count, "A").End(xlUp)).Offset(, 1)
.Formula = "=VLOOKUP(A2,I:I,1,FALSE)"
.Value = .Value
.SpecialCells(xlCellTypeConstants, 16).Offset(, -1).Copy Range("I" & Rows.Count).End(xlUp).Offset(1)
.ClearContents
End With
Application.ScreenUpdating = True
End Sub
You can use whatever column you like as the dummy column.
Info: Done get caught in the loop
Some notes on speed testing:
Compile vba project before running test.
For Each Loops execute faster than For i = 1 To 10 loops.
If possible exit the loop if the answer is found to prevent pointless loops with Exit For.
Long executes faster than integer.
Finally a faster loop method (if you must loop but its still not as fast as the above non-looping method):
Sub Looping()
Dim vLookup As Variant, vData As Variant, vOutput As Variant
Dim x, y
Dim nCount As Long
Dim bMatch As Boolean
Application.ScreenUpdating = False
vData = Range("A2", Cells(Rows.Count, "A").End(xlUp)).Value
vLookup = Range("I2", Cells(Rows.Count, "I").End(xlUp)).Value
ReDim vOutput(UBound(vData, 1), 0)
For Each x In vData
bMatch = False
For Each y In vLookup
If x = y Then
bMatch = True: Exit For
End If
Next y
If Not bMatch Then
nCount = nCount + 1: vOutput(nCount, 0) = x
End If
Next x
Range("I" & Rows.Count).End(xlUp).Offset(1).Resize(nCount).Value = vOutput
Application.ScreenUpdating = True
End Sub
As per @brettdj comments a For Next alternative:
For x = 1 To UBound(vData, 1)
bMatch = False
For y = 1 To UBound(vLookup, 1)
If vData(x, 1) = vLookup(y, 1) Then
bMatch = True: Exit For
End If
Next y
If Not bMatch Then
nCount = nCount + 1: vOutput(nCount, 0) = vData(x, 1)
End If
Next x
if you use .Value2 instead of .Value it will be a little bit faster again.
Just wrote this quickly... Can you test this for me?
Sub Sample()
Dim wsDes As Worksheet, wsSrc As Worksheet
Dim rngDes As Range, rngSrc As Range
Dim DesLRow As Long, SrcLRow As Long
Dim i As Long, j As Long, n As Long
Dim DesArray, SrcArray, TempAr() As String
Dim boolFound As Boolean
Set wsDes = ThisWorkbook.Sheets("Sheet1")
Set wsSrc = ThisWorkbook.Sheets("Sheet2")
DesLRow = wsDes.Cells(Rows.Count, 1).End(xlUp).Row
SrcLRow = wsSrc.Cells(Rows.Count, 1).End(xlUp).Row
Set rngDes = wsDes.Range("A2:A" & DesLRow)
Set rngSrc = wsSrc.Range("I3:I" & SrcLRow)
DesArray = rngDes.Value
SrcArray = rngSrc.Value
For i = LBound(SrcArray) To UBound(SrcArray)
For j = LBound(DesArray) To UBound(DesArray)
If SrcArray(i, 1) = DesArray(j, 1) Then
boolFound = True
Exit For
End If
Next j
If boolFound = False Then
ReDim Preserve TempAr(n)
TempAr(n) = SrcArray(i, 1)
n = n + 1
Else
boolFound = False
End If
Next i
wsDes.Cells(DesLRow + 1, 1).Resize(UBound(TempAr) + 1, 1).Value = _
Application.Transpose(TempAr)
End Sub