Compare Two columns looking for missing values

nicolehalliday

Board Regular
Joined
May 19, 2010
Messages
56
Hi,
I have two lists that are supposed to be the same, however one is updated with more info. The lists are in column A and B. I want to know what the differences are, and what cell entries column A is missing (B is the updated longer column). Also, some of the entries in the columns are duplicates, but that is meant to be... So I am also wondering if column A has the same amount of a certain entry as column B. I am an excel rookie and would really appreciate your help!

Much Thanks
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Try this for columns "A & B".
Code:
[COLOR="Navy"]Sub[/COLOR] MG01Sep57
[COLOR="Navy"]Dim[/COLOR] RngA    [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] RngB    [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Q
[COLOR="Navy"]Set[/COLOR] RngA = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] RngB = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Rng = Union(RngA, RngB)
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            .Add Dn.Value, Array(0, 0)
             Q = .Item(Dn.Value)
             [COLOR="Navy"]If[/COLOR] Dn.Column = 1 [COLOR="Navy"]Then[/COLOR] Q(0) = 1 Else Q(1) = 1
             .Item(Dn.Value) = Q
    [COLOR="Navy"]Else[/COLOR]
            Q = .Item(Dn.Value)
            [COLOR="Navy"]If[/COLOR] Dn.Column = 1 [COLOR="Navy"]Then[/COLOR] Q(0) = Q(0) + 1 Else Q(1) = Q(1) + 1
            .Item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K, msg [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .Keys
    [COLOR="Navy"]If[/COLOR] Not .Item(K)(0) = .Item(K)(1) [COLOR="Navy"]Then[/COLOR]
        msg = msg & "Val= " & K & Space(2) & "Col(1)= " & .Item(K)(0) & Space(2) & "Col(2)" & .Item(K)(1) & Chr(10)
    [COLOR="Navy"]End[/COLOR] If
  [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
MsgBox msg
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
U can try this, change 4 and 5 to ur columns:

Sub CompareFields()
Dim i As Integer, j As Integer
Dim iRowsCount As Integer, iColumnsCount As Integer
Dim Item1 As String, Item2 As String

iRowsCount = ActiveSheet.UsedRange.Rows.Count
iColumnsCount = ActiveSheet.UsedRange.Columns.Count

With ActiveSheet
For i = 2 To iRowsCount
Item1 = Cells(i, 4).Value
Item2 = Cells(i, 5).Value
If Item1 = "" And Item2 = "" Then
Else
If Item1 <> Item2 Then
Cells(i, 5).Select
ActiveCell.Interior.ColorIndex = 36
End If
End If
Next i
End With

End Sub
 
Upvote 0
Hi Guys

I too am using the code used by MickG.

so i am wondering how i can do the same task but use data from sheet1 and sheet2 of the same workbook instead of date from the same worksheet, as presently getting and error message.

my changes are in bold.

Rich (BB code):
Sub MG01Sep57()
Dim RngA    As Range
Dim Dn      As Range
Dim RngB    As Range
Dim Rng     As Range
Dim Q
Set RngA = Worksheets("Sheet1").Range(Range("g5"), Range("g" & Rows.Count).End(xlUp))
Set RngB = Worksheets("Sheet2").Range(Range("a2"), Range("a" & Rows.Count).End(xlUp))
Set Rng = Union(RngA, RngB)
    With CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
    For Each Dn In Rng
        If Not .Exists(Dn.Value) Then
            .Add Dn.Value, Array(0, 0)
             Q = .Item(Dn.Value)
             If Dn.Column = 1 Then Q(0) = 1 Else Q(1) = 1
             .Item(Dn.Value) = Q
    Else
            Q = .Item(Dn.Value)
            If Dn.Column = 1 Then Q(0) = Q(0) + 1 Else Q(1) = Q(1) + 1
            .Item(Dn.Value) = Q
    End If
Next
Dim K, msg As String
 For Each K In .Keys
    If Not .Item(K)(0) = .Item(K)(1) Then
        msg = msg & "Val= " & K & Space(2) & "Col(1)= " & .Item(K)(0) & Space(2) & "Col(2)" & .Item(K)(1) & Chr(10)
    End If
  Next K
End With
MsgBox msg
End Sub

Any help would be appreciated.

Thanks

Ally
 
Upvote 0
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG16Sep05
[COLOR="Navy"]Dim[/COLOR] RngA    [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] RngB    [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Q
[COLOR="Navy"]Dim[/COLOR] Ray
[COLOR="Navy"]Dim[/COLOR] Ar      [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
With Sheets("Sheet1") '[COLOR="Green"][B]Sht1[/B][/COLOR]
[COLOR="Navy"]Set[/COLOR] RngA = .Range(.Range("g5"), .Range("g" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
With Sheets("Sheet2") '[COLOR="Green"][B]Sht2[/B][/COLOR]
[COLOR="Navy"]Set[/COLOR] RngB = .Range(.Range("a2"), .Range("a" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
Ray = Array(RngA, RngB)
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] Ar = 0 To UBound(Ray)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Ray(Ar)
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            .Add Dn.Value, Array(0, 0)
             Q = .Item(Dn.Value)
             [COLOR="Navy"]If[/COLOR] Ar = 0 [COLOR="Navy"]Then[/COLOR] Q(0) = 1 Else Q(1) = 1
             .Item(Dn.Value) = Q
    [COLOR="Navy"]Else[/COLOR]
            Q = .Item(Dn.Value)
            [COLOR="Navy"]If[/COLOR] Ar = 0 [COLOR="Navy"]Then[/COLOR] Q(0) = Q(0) + 1 Else Q(1) = Q(1) + 1
            .Item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Next[/COLOR] Ar
[COLOR="Navy"]Dim[/COLOR] K, msg [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .Keys
    [COLOR="Navy"]If[/COLOR] Not .Item(K)(0) = .Item(K)(1) [COLOR="Navy"]Then[/COLOR]
        msg = msg & "Val= " & K & Space(2) & "Col(1)= " & .Item(K)(0) & Space(2) & "Col(2)" & .Item(K)(1) & Chr(10)
    [COLOR="Navy"]End[/COLOR] If
  [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
MsgBox msg
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
thanks for the above code, i am trying to output to a worksheet.

I am able to amend the code to create a temp worksheet and copy the array to the worksheet however the problem i have is that i need each entry in the array to be on a different row.

At the moment the entire array is in one block. I am not sure how i go about this. I have tried putting in a loop, but all i get is the last entry in the array over again for the number of items in the array. Am i placing the loop in the wrong place. or do i need to output to the worksheet after each comparison check

so something like this

A B C D
1234 0 1234 1
4567 1 4567 0

Hope this makes sense.

Many Thanks

Ally.
 
Upvote 0
Try this:-
Results sheet(5) , Change as required
See code comments
Code:
[COLOR=navy]Sub[/COLOR] MG21Sep40
[COLOR=navy]Dim[/COLOR] RngA    [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn      [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] RngB    [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Rng     [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Q
[COLOR=navy]Dim[/COLOR] Ray
[COLOR=navy]Dim[/COLOR] Ar      [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
With Sheets("Sheet1") '[COLOR=green][B]Sht1[/B][/COLOR]
[COLOR=navy]Set[/COLOR] RngA = .Range(.Range("g5"), .Range("g" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
With Sheets("Sheet2") '[COLOR=green][B]Sht2[/B][/COLOR]
[COLOR=navy]Set[/COLOR] RngB = .Range(.Range("a2"), .Range("a" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
Ray = Array(RngA, RngB)
    [COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
    [COLOR=navy]For[/COLOR] Ar = 0 To UBound(Ray)
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Ray(Ar)
        [COLOR=navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
            .Add Dn.Value, Array(0, 0)
             Q = .Item(Dn.Value)
             [COLOR=navy]If[/COLOR] Ar = 0 [COLOR=navy]Then[/COLOR] Q(0) = 1 Else Q(1) = 1
             .Item(Dn.Value) = Q
    [COLOR=navy]Else[/COLOR]
            Q = .Item(Dn.Value)
            [COLOR=navy]If[/COLOR] Ar = 0 [COLOR=navy]Then[/COLOR] Q(0) = Q(0) + 1 Else Q(1) = Q(1) + 1
            .Item(Dn.Value) = Q
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
[COLOR=navy]Next[/COLOR] Ar
[COLOR=navy]Dim[/COLOR] K, msg [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
 c = 1
'[COLOR=green][B]Change Sheet5. Name (4 places below) as required[/B][/COLOR]
Sheets("Sheet5").Range("A1:C1").Value = Array("Value", "Sht(1)", "Sht(2)")
 [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .Keys
    [COLOR=navy]If[/COLOR] Not .Item(K)(0) = .Item(K)(1) [COLOR=navy]Then[/COLOR]
        c = c + 1
        Sheets("Sheet5").Cells(c, 1) = K
        Sheets("Sheet5").Cells(c, 2) = .Item(K)(0)
        Sheets("Sheet5").Cells(c, 3) = .Item(K)(1)
        '[COLOR=green][B]Remove line below as req'ed[/B][/COLOR]
        msg = msg & "Val= " & K & Space(2) & "Col(1)= " & .Item(K)(0) & Space(2) & "Col(2)" & .Item(K)(1) & Chr(10)
    [COLOR=navy]End[/COLOR] If
  [COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
'[COLOR=green][B]Remove line below as req'ed[/B][/COLOR]
MsgBox msg
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Upvote 0

Forum statistics

Threads
1,224,502
Messages
6,179,126
Members
452,890
Latest member
Nikhil Ramesh

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