Question posted 2013 ยท +8 upvotes
EDIT: Instead for my solution, use something like
For i = 1 To tmpRngSrcMax
If rngSrc(i) <> rngDes(i) Then ...
Next i
It is about 100 times faster.
I have to compare two columns containing string data using VBA. This is my approach:
Set rngDes = wsDes.Range("A2:A" & wsDes.Cells(Rows.Count, 1).End(xlUp).Row)
Set rngSrc = wsSrc.Range("I3:I" & wsSrc.Cells(Rows.Count, 1).End(xlUp).Row)
tmpRngSrcMax = wsSrc.Cells(Rows.Count, 1).End(xlUp).Row
cntNewItems = 0
For Each x In rngSrc
tmpFound = Application.WorksheetFunction.CountIf(rngDes, x.Row)
Application.StatusBar = "Processed: " & x.Row & " of " & tmpRngSrcMax & " / " & Format(x.Row / tmpRngSrcMax, "Percent")
DoEvents ' keeps Excel away from the "Not responding" state
If tmpFound = 0 Then ' new item
cntNewItems = cntNewItems + 1
tmpLastRow = wsDes.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' first empty row on target sheet
wsDes.Cells(tmpLastRow, 1) = wsSrc.Cells(x.Row, 9)
End If
Next x
So, I’m using a For Each loop to iterate trough the 1st (src) column, and the CountIf method to check if the item is already present in the 2nd (des) column. If not, copy to the end of the 1st (src) column.
The code works, but on my machine it takes ~200s given columns with around 7000 rows. I noticed that CountIf works way faster when used directly as a formula.
Does anyone has ideas for code optimization?
Accepted answer +6 upvotes
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
4 code variants in this answer
- Variant 1 โ 34 lines, starts with
Sub ForLoop() - Variant 2 โ 40 lines, starts with
Sub Sample() - Variant 3 โ 26 lines, starts with
Sub Main() - Variant 4 โ 15 lines, starts with
Sub FillRandom()
Excel VBA objects referenced (5)
Applicationโ Using events with the Application objectApplicationโ Working with Other ApplicationsRangeโ Refer to Cells by Using a Range ObjectRangeโ Delete Duplicate Entries in a RangeRows.Countโ Count function (Microsoft Access SQL)
Top excel-vba Q&A (6)
- How to clear the entire array? +58 (2010)
- How to change Format of a Cell to Text using VBA +55 (2011)
- Download attachment from Outlook and Open in Excel +43 (2012)
- Can a VBA function in Excel return a range? +36 (2009)
- 2 Dimensional array from range +34 (2013)
- Hiding an Excel worksheet with VBA +33 (2009)
excel-vba solutions on this site
.