# Compare two columns in an Excel spreadsheet

I have a VBA code that compares values in two columns (Column A & B), which runs slow. Please advise me the changes to make it run fast

The below code works just fine, but is running slow. Please advise me on how to make it run fast

 Sub compare()
Dim ListA As Range
Dim ListB As Range
Dim c As Range
Call Unprotect
Set ListA = Range("A2:A1048576")
Set ListB = Range("B2:B1048576")

Application.ScreenUpdating = False

Range("C1").Value = "Files in A that are NOT in B"
Range("D1").Value = "Files in B that are Not in A"
Range("E1").Value = "Matching Files"

For Each c In ListA
If Application.CountIf(ListB, c) = 0 Then
Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, "C").Value = c
End If
Next c

For Each c In ListA
If Application.CountIf(ListB, c) >= 1 Then
Cells(Cells(Rows.Count, "E").End(xlUp).Row + 1, "E").Value = c
End If
Next c

For Each c In ListB
If Application.CountIf(ListA, c) = 0 Then
Cells(Cells(Rows.Count, "D").End(xlUp).Row + 1, "D").Value = c
End If
Next c

Application.ScreenUpdating = True

Call Protect
End Sub


Any code changes to make the code run fast will be appreciated. Thanks

• Welcome to Code Review! I changed the title so that it describes what the code does per site goals: "State what your code does in your title, not your main concerns about it.". Feel free to give it a different title if there is something more appropriate. – Sᴀᴍ Onᴇᴌᴀ Jan 2 '18 at 18:26

I'm sure you can further optimize the code, but this will definitely run faster.

It will run faster for a number of reasons, firstly I've combined one of your loops so you only have two For Loops, the second reason is that the code won't be looking at every cell in the worksheet, but it will find the last row with data and loop until then:

Sub compare()
Dim ListA As Range
Dim ListB As Range
Dim c As Range
Call Unprotect

ListARange = Cells(Rows.Count, "A").End(xlUp).Row 'find the last row with data on column A
ListBRange = Cells(Rows.Count, "B").End(xlUp).Row 'find the last row with data on column B

Set ListA = Range("A2:A" & ListARange) 'set your range only until the last row with data
Set ListB = Range("B2:B" & ListBRange)
Application.ScreenUpdating = False

Range("C1").Value = "Files in A that are NOT in B"
Range("D1").Value = "Files in B that are Not in A"
Range("E1").Value = "Matching Files"

For Each c In ListA
If Application.CountIf(ListB, c) = 0 Then
Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, "C").Value = c
ElseIf Application.CountIf(ListB, c) >= 1 Then
Cells(Cells(Rows.Count, "E").End(xlUp).Row + 1, "E").Value = c
End If
Next c

For Each c In ListB
If Application.CountIf(ListA, c) = 0 Then Cells(Cells(Rows.Count, "D").End(xlUp).Row + 1, "D").Value = c
Next c

Application.ScreenUpdating = True

Call Protect
End Sub

• Why will it run faster? I few words to explain the improvement may make your review more accessible to many readers. – Stop ongoing harm to Monica Jan 2 '18 at 19:14

Using Dynamic Ranges (a Range that resizes to fit the actual data) will give you a huge performance boost.

Range("A2:A1048576") ' 1048575 cells

Range("A2", Range("A" & Rows.Count).End(xlUp)) 'All Cells between A1 and the last non-empty cell in Column A

Reading and writing to an Array is faster then working with the Cells themselves. Use Range.Value or Range.Value2 to return or write an Array of values from or to the target range. Range.Value2 is faster then Range.Value because it ignores formatting.

It is good practice to fully qualify your Ranges. In this way, your code will work as intended no matter what Worksheet or Workbook is active when the procedure is called.

With ThisWorkbook.Worksheets("Sheet1")
Set listA = .Range("A2:A1048576")


Collections should be used when comparing two or more list. If you need to both a unique identifier (Key) and a reference (Value) then a Scripting.Dictionary is ideal. Scripting.Dictionary have built in methods to lookup values or object references stored in Key/Value pairs. Since the OP just need to lookup Keys, I used an ArrayList in my code.

## Refactored Code

Sub Compare_By_Arraylist()
Dim v As Variant
Dim listA As Object, listNotA As Object, listMatches As Object
Set listA = CreateObject("System.Collections.ArrayList")
Set listNotA = CreateObject("System.Collections.ArrayList")
Set listMatches = CreateObject("System.Collections.ArrayList")

With ThisWorkbook.Worksheets("Sheet1")
For Each v In .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Value2
If Not listA.Contains(v) Then listA.Add v
Next

For Each v In .Range("B2", .Range("B" & .Rows.Count).End(xlUp)).Value2
If listA.Contains(v) Then
If Not listMatches.Contains(v) Then listMatches.Add v
Else
End If
Next

For Each v In .Range("B2", .Range("B" & .Rows.Count).End(xlUp)).Value2
If listA.Contains(v) Then listA.Remove v
Next

Call UnProtect
Application.ScreenUpdating = False
.Range("C1:E1").Value = Array("Files in A that are NOT in B", "Files in B that are Not in A", "Matching Files")
.Range("C2").Resize(listA.Count).Value = Application.WorksheetFunction.Transpose(listA.ToArray)
.Range("D2").Resize(listNotA.Count).Value = Application.WorksheetFunction.Transpose(listNotA.ToArray)
.Range("E2").Resize(listMatches.Count).Value = Application.WorksheetFunction.Transpose(listMatches.ToArray)
Application.ScreenUpdating = True
Call Protect

End With

End Sub


Looping through the cells in a worksheet is slow. Better to bulk read the values into an array and process them then bulk write back to the worksheet.

The worksheet MATCH is faster than COUNTIF (see Is there a faster CountIF ) at counting and even faster if you only want to prove existence rather than a full count. Scripting dictionaries have their own indexed .Exists method but they do take time to load even from an array.

Option Explicit

Sub compareCOLs()
Dim listA As Variant, listB As Variant, listC As Variant
Dim a As Long, b As Long, c As Long, d As Long, e As Long

With Worksheets("sheet2")
listA = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp)).Value2
listB = .Range(.Cells(2, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Value2
ReDim listC(1 To (UBound(listA, 1) + UBound(listB, 1)), 1 To 3)

'COUNTIF-style processing
For a = LBound(listA, 1) To UBound(listA, 1)
If IsError(Application.Match(listA(a, 1), listB, 0)) Then
c = c + 1
listC(c, 1) = listA(a, 1)
Else
e = e + 1
listC(e, 3) = listA(a, 1)
End If
Next a
For b = LBound(listB, 1) To UBound(listB, 1)
If IsError(Application.Match(listB(b, 1), listA, 0)) Then
d = d + 1
listC(d, 2) = listB(b, 1)
End If
Next b

'write results back to the worksheet
.Cells(1, "C").Resize(1, 3) = Array("Files in A that are NOT in B", _
"Files in B that are Not in A", _
"Matching Files")
.Cells(2, "C").Resize(UBound(listC, 1), UBound(listC, 2)) = listC
End With
End Sub