VBA to Compare Columns

Brentsa

Board Regular
Joined
Oct 3, 2013
Messages
118
Office Version
  1. 365
Platform
  1. Windows
I have a list of numbers in random order in Column A and Column B. I want to compare these two columns. All the numbers that are the same can remain in Column A and Column B. Numbers that are only found in Column A will appear in Column D and Numbers that are only found in Column B will appear in Column E. All results will be ascending.

Ie
Column A: Column B
1 2
9 3
8 4
10 6
3 8
12 9
7 12
4 15
13 1
11 5
22

The result I want is
Column A: Column B: Column D: Column E:
1 1 7 2
3 3 10 5
4 4 11 6
8 8 13 15
9 9 22
12 12
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Edit: Oops, I forgot the title "vba". Does it have to be vba or could you use the following?

Try this

21 02 15.xlsm
ABCDE
1
21272
393105
484116
51061315
63822
7129
8712
9415
10131
11115
1222
Missing
Cell Formulas
RangeFormula
D2:D6D2=SORT(FILTER(A2:A12,ISNA(MATCH(A2:A12,B2:B11,0)),""))
E2:E5E2=SORT(FILTER(B2:B11,ISNA(MATCH(B2:B11,A2:A12,0)),""))
Dynamic array formulas.
 
Last edited:
Upvote 0
Thanks for the response but I was looking for a VBA answer as my list is anything between 500 - 1000 rows. When I changed the formula to A:A and B:B it does give me the result however my Column A and Column B remains the same.

However Column A and B should show the numbers that match each other in ascending order.
 
Upvote 0
Give this a try with a copy of your workbook.

VBA Code:
Sub CompareColumns()
  Dim lrA As Long, lrB As Long
  
  lrA = Range("A" & Rows.Count).End(xlUp).Row
  lrB = Range("B" & Rows.Count).End(xlUp).Row
  Application.ScreenUpdating = False
  With Range("C2")
    .Formula2 = Replace(Replace("=SORT(FILTER(A2:A@,ISNUMBER(MATCH(A2:A@,B2:B#,0)),""""))", "@", lrA), "#", lrB)
    .SpillingToRange.Resize(, 2).Value = .SpillingToRange.Value
  End With
  With Range("F2")
    .Formula2 = Replace(Replace("=SORT(FILTER(A2:A@,ISNA(MATCH(A2:A@,B2:B#,0)),""""))", "@", lrA), "#", lrB)
    .SpillingToRange.Value = .SpillingToRange.Value
  End With
  With Range("G2")
    .Formula2 = Replace(Replace("=SORT(FILTER(B2:B#,ISNA(MATCH(B2:B#,A2:A@,0)),""""))", "@", lrA), "#", lrB)
    .SpillingToRange.Value = .SpillingToRange.Value
  End With
  Columns("A:B").Delete
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
1613390026556.png


Sub CompareColumns()
Dim lrA As Long, lrB As Long

lrA = Range("A" & Rows.Count).End(xlUp).Row
lrB = Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
With Range("C2")
.Formula2 = Replace(Replace("=SORT(FILTER(A2:A@,ISNUMBER(MATCH(A2:A@,B2:B#,0)),""""))", "@", lrA), "#", lrB)
.SpillingToRange.Resize(, 2).Value = .SpillingToRange.Value
End With
With Range("F2")
.Formula2 = Replace(Replace("=SORT(FILTER(A2:A@,ISNA(MATCH(A2:A@,B2:B#,0)),""""))", "@", lrA), "#", lrB)
.SpillingToRange.Value = .SpillingToRange.Value
End With
With Range("G2")
.Formula2 = Replace(Replace("=SORT(FILTER(B2:B#,ISNA(MATCH(B2:B#,A2:A@,0)),""""))", "@", lrA), "#", lrB)
.SpillingToRange.Value = .SpillingToRange.Value
End With
Columns("A:B").Delete
Application.ScreenUpdating = True
End Sub

The error is in the highlighted area
 
Upvote 0
The error is in the highlighted area
The data you ran it on must have resulted in one or more of the result columns have no entries or just a single entry, which I hadn't allowed for. Try this one .

BTW, when posting code please use code tags. My signature block below has more info on that. If you want to highlight some of the code like you did, then use the </>RICH tags and you can still do that.

I also suggest that you investigate XL2BB for providing sample data & expected results to make it easier for helpers to understand just what you have & where it is and also what you want & where it is to be. It is very hard to tell what is in what column in post #1 here.

VBA Code:
Sub CompareColumns_v2()
  Dim lrA As Long, lrB As Long
  
  lrA = Range("A" & Rows.Count).End(xlUp).Row
  lrB = Range("B" & Rows.Count).End(xlUp).Row
  Application.ScreenUpdating = False
  Range("C2").Formula2 = Replace(Replace("=SORT(FILTER(A2:A@,ISNUMBER(MATCH(A2:A@,B2:B#,0)),""""))", "@", lrA), "#", lrB)
  Range("D2").Formula2 = Replace(Replace("=SORT(FILTER(A2:A@,ISNUMBER(MATCH(A2:A@,B2:B#,0)),""""))", "@", lrA), "#", lrB)
  Range("F2").Formula2 = Replace(Replace("=SORT(FILTER(A2:A@,ISNA(MATCH(A2:A@,B2:B#,0)),""""))", "@", lrA), "#", lrB)
  Range("G2").Formula2 = Replace(Replace("=SORT(FILTER(B2:B#,ISNA(MATCH(B2:B#,A2:A@,0)),""""))", "@", lrA), "#", lrB)
  With Intersect(ActiveSheet.UsedRange, Columns("C:G"))
    .Value = .Value
  End With
  Columns("A:B").Delete
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thanks working perfectly. Just one additional question: Is there a line that i can put in so that if there are any words in Column A or B of my original data that it can ignore them? No train smash if it cant be done.
BTW, when posting code please use code tags. My signature block below has more info on that. If you want to highlight some of the code like you did, then use the </>RICH tags and you can still do that.
I will keep this in mind going forward.
I also suggest that you investigate XL2BB for providing sample data & expected results to make it easier for helpers to understand just what you have & where it is and also what you want & where it is to be. It is very hard to tell what is in what column in post #1 here.
Our IT department has blocked XL2BB as I have tried before.
 
Upvote 0
Is there a line that i can put in so that if there are any words in Column A or B of my original data that it can ignore them?

Try this

VBA Code:
Sub CompareColumns_v3()
  Dim lrA As Long, lrB As Long
  
  lrA = Range("A" & Rows.Count).End(xlUp).Row
  lrB = Range("B" & Rows.Count).End(xlUp).Row
  Application.ScreenUpdating = False
  Range("C2").Formula2 = Replace(Replace("=SORT(FILTER(A2:A@,(ISNUMBER(MATCH(A2:A@,B2:B#,0)))*ISNUMBER(A2:A@+0),""""))", "@", lrA), "#", lrB)
  Range("D2").Formula2 = Replace(Replace("=SORT(FILTER(A2:A@,(ISNUMBER(MATCH(A2:A@,B2:B#,0)))*ISNUMBER(A2:A@+0),""""))", "@", lrA), "#", lrB)
  Range("F2").Formula2 = Replace(Replace("=SORT(FILTER(A2:A@,(ISNA(MATCH(A2:A@,B2:B#,0)))*ISNUMBER(A2:A@+0),""""))", "@", lrA), "#", lrB)
  Range("G2").Formula2 = Replace(Replace("=SORT(FILTER(B2:B#,(ISNA(MATCH(B2:B#,A2:A@,0)))*ISNUMBER(B2:B#+0),""""))", "@", lrA), "#", lrB)
  With Intersect(ActiveSheet.UsedRange, Columns("C:G"))
    .Value = .Value
  End With
  Columns("A:B").Delete
  Application.ScreenUpdating = True
End Sub

Before:

Brentsa.xlsm
AB
1
212
393
484
5106
6one8
73one
8twofour
9129
10712
11415
12131
13115
1422
Lists


After:

Brentsa.xlsm
ABCDE
1
21172
333105
444116
5881315
69922
71212
8
Lists



Our IT department has blocked XL2BB as I have tried before.
OK, fair enough. :(
If you start future threads, might be a good idea to repeat that info in post #1 so people like me don't keep asking you. :)
 
Upvote 0
Over this weekend I realized a error in the VBA result

VBA Code:
Sub CompareData()
Sheets("Calculator").Activate
Columns("A:G").Select
Selection.Style = "Comma"
    
'Compare Column A & B
 Dim lrA As Long, lrB As Long
  
  lrA = Range("A" & Rows.Count).End(xlUp).Row
  lrB = Range("B" & Rows.Count).End(xlUp).Row
  Application.ScreenUpdating = False
  Range("C1").Formula2 = Replace(Replace("=SORT(FILTER(A1:A@,ISNUMBER(MATCH(A1:A@,B1:B#,0)),""""))", "@", lrA), "#", lrB)
  Range("D1").Formula2 = Replace(Replace("=SORT(FILTER(A1:A@,ISNUMBER(MATCH(A1:A@,B1:B#,0)),""""))", "@", lrA), "#", lrB)
  Range("F1").Formula2 = Replace(Replace("=SORT(FILTER(A1:A@,ISNA(MATCH(A1:A@,B1:B#,0)),""""))", "@", lrA), "#", lrB)
  Range("G1").Formula2 = Replace(Replace("=SORT(FILTER(B1:B#,ISNA(MATCH(B1:B#,A1:A@,0)),""""))", "@", lrA), "#", lrB)
  With Intersect(ActiveSheet.UsedRange, Columns("C:G"))
    .Value = .Value
  End With
  Columns("A:B").Delete
  Application.ScreenUpdating = True
'Sort all Columns in ascending number format
  Sheets("Calculator").Range("A:G", Range("A:G").End(xlDown)).Sort Key1:=Range("A:G"), Order1:=xlAscending, Header:=xlNo
    Columns("A:G").Select
    Selection.Style = "Comma"
    Range("a1").Select
   
End Sub

In Column A is have duplicate numbers and Column B I have only one matching number. At the moment the VBA code eliminates both numbers in Column A as it has found corresponding number in Column B. What I need is for it to only elimate one set matching number and move the other non matching number to column. For example Column A has 8 and 12 in it twice. Column B has 8 twice but 12 once.

Book1
AB
1
212
393
484
5106
6one8
73one
8twofour
9129
10712
11415
12131
13115
14228
1512
168
Sheet1


So the results should look like this:
Book1
ABCDE
1
21172
333105
444116
5881215
68813
79922
81212
Sheet2
 
Upvote 0
Sorry, I have been away for a while. You could give this a try.

VBA Code:
Sub CompareColumns_v4()
  Dim AL1 As Object, AL2 As Object, AL3 As Object, AL4 As Object
  Dim a As Variant, itm As Variant
  Dim i As Long
  
  Set AL1 = CreateObject("System.Collections.ArrayList")
  Set AL2 = CreateObject("System.Collections.ArrayList")
  Set AL3 = CreateObject("System.Collections.ArrayList")
  Set AL4 = CreateObject("System.Collections.ArrayList")
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    If IsNumeric(a(i, 1)) Then AL1.Add a(i, 1)
  Next i
  a = Range("B2", Range("B" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    If IsNumeric(a(i, 1)) Then AL2.Add a(i, 1)
  Next i
  For Each itm In AL1
    If AL2.contains(itm) Then
      AL3.Add itm
      AL2.Remove itm
    Else
      AL4.Add itm
    End If
  Next itm
  If AL3.Count > 0 Then
    AL3.Sort
    Range("C2:D2").Resize(AL3.Count).Value = Application.Transpose(AL3.ToArray)
  End If
  If AL4.Count > 0 Then
    AL4.Sort
    Range("F2").Resize(AL4.Count).Value = Application.Transpose(AL4.ToArray)
  End If
  If AL2.Count > 0 Then
    AL2.Sort
    Range("G2").Resize(AL2.Count).Value = Application.Transpose(AL2.ToArray)
  End If
  Columns("A:B").Delete
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,827
Messages
6,121,823
Members
449,049
Latest member
cybersurfer5000

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top