VBA for compare two columns and show differences in another

[chuf]

Hello.

I've spent the last two hours searching for this, i know its here.. but i can't find it.

I saw a great code which compared the values in two columns A and B, data such as A123 and then shows, in another column ie C , things in A and not in B and in another column ie D things in B and not in A.

Really appreciate your help in doing this, have barmy colleague who i've promised to help

Ta in advance. Chuf

 

[Jabes7]

Hi,

Can you pls do the same for unmatched records in both the column?

I have two sheets and the sample design is

Sheet1 ---------Sheet2
ID Name sal -----ID Sal
100 aaa 1000 ---100 1000
101 bbb 2000 ---101 2000
102 ccc 3000 ---102 3000
103 ddd 4000
104 eee 5000
105 fff 6000



Now i need to compare ID COLUMN(unique column) of two Sheets and find the unmatched records.

And then Update the unmatched records into Sheet2

Similarly it should look like

Sheet1 --------Sheet2
ID Name sal ----ID Sal
100 aaa 1000 --100 1000
101 bbb 2000---101 2000
102 ccc 3000 -- 102 3000
103 ddd 4000 ---103 4000
104 eee 5000 ---104 5000
105 fff 6000 1---105 6000


Thanks in ADVANCE

 

[acklovo2]

How can I make this code dynamic, I have to choose the columns to be compared

Can you help me?


Sub test()
Dim a, i As Long, b(), n As Long, x
a = Range("a1").CurrentRegion.Resize(, 2).Value
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For i = 1 To UBound(a, 1)
If (Not IsEmpty(a(i, 1))) * (Not .exists(a(i, 1))) Then .Add a(i, 1), Nothing
Next
ReDim b(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
If Not IsEmpty(a(i, 2)) Then
If Not .exists(a(i, 2)) Then
n = n + 1: b(n, 1) = a(i, 2)
Else
.Remove a(i, 2)
End If
End If
Next
x = .keys
End With
With Range("d1")
.CurrentRegion.ClearContents
.Resize(, 2).Value = [{"No Esta en A", "No Esta en B"}]
With .Offset(1)
If n > 0 Then .Resize.Value = b
End With
On Error Resume Next
.Offset(1, 1).Resize(.Count).Value = Application.Transpose(x)
End With
End Sub

 

[acklovo2]

Hi Pretty1996, did you find a solution for this?

I wonder if anyone can still help me in here.

I'm using the code shown in this thread (thank you for supplying it)

however for some weird reason I cant get it work properly.

what I mean is it shows all values that are missing in column A but it doesnt show all values missing in column B?

any help or suggestions?

thanks

 

[sywa83]

This code is using ascii value.


Sub test()
Dim col_id As Integer
Dim col_str As String
Dim basenum As Integer
basenum = 97
For col_count = 0 To 20 Step 2

col_id = basenum + col_count
col_str = Chr(col_id)
For rowint = 1 To Worksheets("Sheet1").UsedRange.Rows.Count

If Range(col_str & rowint).Value > Range(Chr(col_id + 1) & rowint).Value Then
Range(Chr(col_id + 1) & rowint).Select
Selection.Interior.ColorIndex = 3

End If

Next
Next


End Sub

 

[mattu1990]

I'd just like to say thanks for the people who took the time to make this script which compares two columns of data and shows differences. I just dumped it into an Excel file example and it worked perfectly straight away.

Saved me a few hours of trying to work that one out so thanks very much indeed.

 

[mattu1990]

Just to add to what I wrote above. Two problems I have noticed is that the script makes "Data not in A - But are in B" work fine. However, "Data not in B, But are in A" doesn't work.

Another problem is that if there multiple records of the same data, the script lists each duplicate.

Does anyone know a way to make the script ignore differences after they have been listed once?

E.g instead of the list producing: Apples, Apples, Apples, Apples. It would just display Apples once and then move on to the next cell.

and also fix the issue with "Data not in B, But are in A" working?

My code.

<code>

Sub ShowDifferences()


Dim a, i As Long, b(), n As Long, x
a = Range("a1").CurrentRegion.Resize(, 2).Value
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For i = 1 To UBound(a, 1)
If (Not IsEmpty(a(i, 1))) * (Not .exists(a(i, 1))) Then .Add a(i, 1), Nothing
Next
ReDim b(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
If Not IsEmpty(a(i, 2)) Then
If Not .exists(a(i, 2)) Then
n = n + 1: b(n, 1) = a(i, 2)
Else
.Remove a(i, 2)
End If
End If
Next
x = .keys
End With
With Range("d1")
.CurrentRegion.ClearContents
.Resize(, 2).Value = [{"Data Not in A - But are in B", "Data Not in B - But are in A"}]
With .Offset(1)
If n > 0 Then .Resize.Value = b
End With
On Error Resume Next
.Offset(1, 1).Resize(.Count).Value = Application.Transpose(x)
End With






End Sub


</pre></code>

Thanks in advance.

 

[Jabes7]

Hi Pretty1996, did you find a solution for this?

Thanks. The Code is working fine as Expected !

 

[mirabeau]

Just to add to what I wrote above. Two problems I have noticed is that the script makes "Data not in A - But are in B" work fine. However, "Data not in B, But are in A" doesn't work.

Another problem is that if there multiple records of the same data, the script lists each duplicate.

Does anyone know a way to make the script ignore differences after they have been listed once?

E.g instead of the list producing: Apples, Apples, Apples, Apples. It would just display Apples once and then move on to the next cell.

and also fix the issue with "Data not in B, But are in A" working?

My code.
...
...
<code>
</code>

try this on some test data

Sub two_cols()

Dim d1 As Object, d2 As Object, d3 As Object, e

Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")

For Each e In Cells(1).Resize(Cells(Rows.Count, 1).End(3).Row).Value
    d1(e) = True
    d2(e) = True
Next e

For Each e In Cells(2).Resize(Cells(Rows.Count, 2).End(3).Row).Value
    If (d2(e)) * (d1.exists(e)) Then d1.Remove e
    If Not d2(e) Then d3(e) = True
Next e

On Error Resume Next
Range("D1").Resize(d1.Count) = Application.Transpose(d1.keys)
Range("E1").Resize(d3.Count) = Application.Transpose(d3.keys)
On Error GoTo 0

End Sub

 

[mattu1990]

That's brilliant. Thank you very much. It works absolutely perfect.

If I were to nit pick, I would say there are no titles at the top of column D and E but it doesn't really mater to be honest. I've just wrote my own little descriptions on the side.

 

[adruffd]

I know this thread is a few years old but I did not want to start a new post since I am using this post as a reference. The code works perfectly for Comparing in one direction ("In Column B, Not in A") but for the 2nd component the cross reference stops after the 1st deviation. Meaning "In Column A, Not in B" will only return the 1st value. What could be the issue here? Is something interrupting the loop?

' Code Compares two columns for differences (ex. A & B)
' Adds in column C (in A but not B) and column D (in B but not A)




Sub test()
Dim a, i As Long, b(), n As Long, x
a = Range("a1").CurrentRegion.Resize(, 2).Value
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
        If (Not IsEmpty(a(i, 1))) * (Not .exists(a(i, 1))) Then .Add a(i, 1), Nothing
    Next
    ReDim b(1 To UBound(a, 1), 1 To 1)
    For i = 1 To UBound(a, 1)
        If Not IsEmpty(a(i, 2)) Then
            If Not .exists(a(i, 2)) Then
                n = n + 1: b(n, 1) = a(i, 2)
            Else
                .Remove a(i, 2)
            End If
        End If
    Next
    x = .keys
End With
With Range("d1")
    .CurrentRegion.ClearContents
    .Resize(, 2).Value = [{"In Column B, Not in A", "In Column A, Not in B"}]
    With .Offset(1)
        If n > 0 Then .Resize(n).Value = b
    End With
    On Error Resume Next
    .Offset(1, 1).Resize(.Count).Value = Application.Transpose(x)
End With
End Sub