Compare two columns in different worksheets and create a message listing the missing data

Mann750

Board Regular
Joined
Dec 16, 2009
Messages
72
Hi,

I'm sure this query has been answered somewhere else but I can't seem to find it. I basically have information in two worksheets in the same workbook which need to be compared and the missing values from one worksheet need to be listed in a message. There are duplicate values in both worksheets so only need a list of the unique missing values. For example:

Sheet1
Column A
1
2
1
5
5
2
3
5
4

Sheet2
Column A
2
3
3
4
3
4


The message box should state that we are missing 1 and 5 from the dataset as it is not in Sheet2. If the list could be sorted in ascending order that would be great too.

Many thanks!
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this:-
Code:
[COLOR=navy]Sub[/COLOR] MG19Apr19
[COLOR=navy]Dim[/COLOR] Rng1        [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Rng2        [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn          [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] n           [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] i           [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] j           [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] temp        [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] Dic         [COLOR=navy]As[/COLOR] Object
[COLOR=navy]Dim[/COLOR] c           [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Ray()
[COLOR=navy]Dim[/COLOR] R           [COLOR=navy]As[/COLOR] Variant
With Sheets("Sheet1")
[COLOR=navy]Set[/COLOR] Rng1 = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
With Sheets("Sheet2")
[COLOR=navy]Set[/COLOR] Rng2 = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
[COLOR=navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng2: Dic(Dn.Value) = Empty: [COLOR=navy]Next[/COLOR]
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng1
    [COLOR=navy]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR=navy]Then[/COLOR]
        ReDim Preserve Ray(c)
        Ray(c) = Dn
        c = c + 1
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
Dic.removeall
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] R [COLOR=navy]In[/COLOR] Ray: Dic(R) = Empty: [COLOR=navy]Next[/COLOR]
    ReDim Ray(1 To Dic.Count)
        Ray = Dic.keys
[COLOR=navy]For[/COLOR] i = 0 To UBound(Ray)
    [COLOR=navy]For[/COLOR] j = i To UBound(Ray)
        [COLOR=navy]If[/COLOR] Ray(j) < Ray(i) [COLOR=navy]Then[/COLOR]
            temp = Ray(i)
            Ray(i) = Ray(j)
            Ray(j) = temp
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] j
[COLOR=navy]Next[/COLOR] i
MsgBox "Missing Numbers" & vbCrLf & "from Sheet 2 = " & vbCrLf & Join(Ray, vbCrLf)
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,647
Mann750,

Sample raw data worksheets:

<b>Excel 2007</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>A</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style="text-align: right;;">1</td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style="text-align: right;;">2</td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style="text-align: right;;">1</td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style="text-align: right;;">5</td></tr><tr ><td style="color: #161120;text-align: center;">5</td><td style="text-align: right;;">5</td></tr><tr ><td style="color: #161120;text-align: center;">6</td><td style="text-align: right;;">2</td></tr><tr ><td style="color: #161120;text-align: center;">7</td><td style="text-align: right;;">3</td></tr><tr ><td style="color: #161120;text-align: center;">8</td><td style="text-align: right;;">5</td></tr><tr ><td style="color: #161120;text-align: center;">9</td><td style="text-align: right;;">4</td></tr><tr ><td style="color: #161120;text-align: center;">10</td><td style="text-align: right;;"></td></tr></tbody></table><p style="width:3.6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #A6AAB6;border-top:none;text-align: center;background-color: #E0E0F0;color: #161120">Sheet1</p><br /><br />

<b>Excel 2007</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>A</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style="text-align: right;;">2</td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style="text-align: right;;">3</td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style="text-align: right;;">3</td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style="text-align: right;;">4</td></tr><tr ><td style="color: #161120;text-align: center;">5</td><td style="text-align: right;;">3</td></tr><tr ><td style="color: #161120;text-align: center;">6</td><td style="text-align: right;;">4</td></tr><tr ><td style="color: #161120;text-align: center;">7</td><td style="text-align: right;;"></td></tr></tbody></table><p style="width:3.6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #A6AAB6;border-top:none;text-align: center;background-color: #E0E0F0;color: #161120">Sheet2</p><br /><br />

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:
Option Explicit
Sub GetMissing()
' hiker95, 04/19/2013
' http://www.mrexcel.com/forum/excel-questions/698081-compare-two-columns-different-worksheets-create-message-listing-missing-data.html
Dim w1 As Worksheet, w2 As Worksheet
Dim i(), o(), k
Dim r As Long, lr As Long, a As Long, h As String, fr As Long
Dim d1 As Object
Dim sortingArray As Variant, ii As Long, j As Long, temp As Variant
Set w1 = Worksheets("Sheet1")
Set w2 = Worksheets("Sheet2")
lr = w1.Cells(Rows.Count, 1).End(xlUp).Row
i = w1.Range("A1:A" & lr)
Set d1 = CreateObject("Scripting.Dictionary")
For a = 1 To lr
  If i(a, 1) <> "" And IsNumeric(i(a, 1)) Then
    If Not d1.exists(i(a, 1)) Then d1(i(a, 1)) = d1.Count
  End If
Next a
k = d1.Keys
ReDim o(1 To d1.Count, 1 To 1)
For a = 1 To d1.Count
  o(a, 1) = k(a - 1)
Next a
sortingArray = o
For ii = 1 To (UBound(sortingArray, 1) - 1)
  For j = ii To UBound(sortingArray, 1)
    If Val(sortingArray(j, 1)) < Val(sortingArray(ii, 1)) Then
      temp = sortingArray(ii, 1)
      sortingArray(ii, 1) = sortingArray(j, 1)
      sortingArray(j, 1) = temp
    End If
  Next j
Next ii
For ii = 1 To (UBound(sortingArray, 1))
  fr = 0
  On Error Resume Next
  fr = Application.Match(sortingArray(ii, 1), w2.Columns(1), 0)
  On Error GoTo 0
  If fr = 0 Then
    h = h & sortingArray(ii, 1) & ","
  End If
Next ii
If Right(h, 1) = "," Then h = Left(h, Len(h) - 1)
MsgBox "We are missing: " & h & " from Sheet2."
End Sub
Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the GetMissing macro.

You will receive a sorted message box displaying:
We are missing: 1,5 from Sheet2.
 

Mann750

Board Regular
Joined
Dec 16, 2009
Messages
72
Thank you both for your help! I have tested MickG's code and it works fine but I am yet to test yours hiker95. I have another query to add to the codes you have provided.

If there are no missing values in Sheet2 can I use a variation of the following formula (from MikeG's code) to exit the sub and continue with the other modules?:

Code:
If Ray = 0 Then
Exit Sub
Else
Msgbox...
End Sub
Will the Exit Sub stop the whole module running through the different procedures?
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,647
Mann750,

The updated macro below will display a message box to cover both instances:
We are not missing any numbers from Sheet2.
or
We are missing: 1,5 from Sheet2.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code:
Option Explicit
Sub GetMissingV2()
' hiker95, 04/19/2013
' http://www.mrexcel.com/forum/excel-questions/698081-compare-two-columns-different-worksheets-create-message-listing-missing-data.html
Dim w1 As Worksheet, w2 As Worksheet
Dim i(), o(), k
Dim r As Long, lr As Long, a As Long, h As String, fr As Long
Dim d1 As Object
Dim sortingArray As Variant, ii As Long, j As Long, temp As Variant
Set w1 = Worksheets("Sheet1")
Set w2 = Worksheets("Sheet2")
lr = w1.Cells(Rows.Count, 1).End(xlUp).Row
i = w1.Range("A1:A" & lr)
Set d1 = CreateObject("Scripting.Dictionary")
For a = 1 To lr
  If i(a, 1) <> "" And IsNumeric(i(a, 1)) Then
    If Not d1.exists(i(a, 1)) Then d1(i(a, 1)) = d1.Count
  End If
Next a
k = d1.Keys
ReDim o(1 To d1.Count, 1 To 1)
For a = 1 To d1.Count
  o(a, 1) = k(a - 1)
Next a
sortingArray = o
For ii = 1 To (UBound(sortingArray, 1) - 1)
  For j = ii To UBound(sortingArray, 1)
    If Val(sortingArray(j, 1)) < Val(sortingArray(ii, 1)) Then
      temp = sortingArray(ii, 1)
      sortingArray(ii, 1) = sortingArray(j, 1)
      sortingArray(j, 1) = temp
    End If
  Next j
Next ii
For ii = 1 To (UBound(sortingArray, 1))
  fr = 0
  On Error Resume Next
  fr = Application.Match(sortingArray(ii, 1), w2.Columns(1), 0)
  On Error GoTo 0
  If fr = 0 Then
    h = h & sortingArray(ii, 1) & ","
  End If
Next ii
If h = "" Then
  MsgBox "We are not missing any numbers from Sheet2."
Else
  If Right(h, 1) = "," Then h = Left(h, Len(h) - 1)
  MsgBox "We are missing: " & h & " from Sheet2."
End If
End Sub
Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the GetMissingV2 macro.
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Add the red line below to exit code if "No Numbers are Missing"
Rich (BB code):
Next
If c = 0 Then MsgBox "No Missing Numbers": Exit Sub
Dic.removeall
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,647
Mann750,

Will the Exit Sub stop the whole module running through the different procedures?
If you are running other macros, in your macro that calls other macros, you could in your macro, at the point where you need to run either of the two posted macros:

Code:
Call MG19Apr19
Or:

Code:
Call GetMissingV2
 
Last edited:

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,647
Mann750,


In my macro GetMissingV2


Change this:

Code:
If h = "" Then
  MsgBox "We are not missing any numbers from Sheet2."
Else
To this:

Code:
If h = "" Then
  Exit Sub
Else
 
Last edited:

mirabeau

Banned user
Joined
Nov 4, 2010
Messages
2,075
I've just had a look at the first several posts of the thread. If the thread has since advanced significantly, then please ignore this post.

Regarding the OP question, I generated a bit of test data with the code at the bottom of this post, and it didn't seem to me that Mick's initial code necessarily gives the output sorted correctly. Probably it's something that I'm doing wrong.

If your data are as in the OP post, i.e. positive integers, then you may be interested in the following, relatively brief, code
Code:
Sub so_whats_missing()
Dim u() As Boolean, v()
Dim a, b, c, q
a = Sheets("sheet1").Cells(1).Resize(Cells(Rows.Count, 1).End(3).Row)
b = Sheets("sheet2").Cells(1).Resize(Cells(Rows.Count, 1).End(3).Row)

ReDim u(Application.Max(a, b))
ReDim v(UBound(u))

For Each c In b
    u(c) = True
Next

For Each c In a
     If Not u(c) Then v(c) = True
Next

q = "Missing from Sheet2 ..." & vbLf
For c = 1 To UBound(v)
    If v(c) Then q = q & c & vbLf
Next

MsgBox q

End Sub
Test data code
Code:
Sub testdata()
Dim n, q
n = 10000
q = Int(n / 5)
With Sheets("sheet1").Cells(1).Resize(n)
    .Resize(Rows.Count).Clear
    .Cells = "=randbetween(1," & q & ")"
    .Value = .Value
End With

With Sheets("sheet2").Cells(1).Resize(n)
    .Resize(Rows.Count).Clear
    .Cells = "=randbetween(1," & q & ")"
    .Value = .Value
End With

End Sub
 

mirabeau

Banned user
Joined
Nov 4, 2010
Messages
2,075
code in post#9 could usefully do with minor modification. like
Code:
Sub so_whats_missing_2()
Dim u() As Boolean, v()
Dim a, b, c, q

With Sheets("sheet1")
    a = .Cells(1).Resize(.Cells(Rows.Count, 1).End(3).Row)
End With
With Sheets("sheet2")
    b = .Cells(1).Resize(.Cells(Rows.Count, 1).End(3).Row)
End With

ReDim u(Application.Max(a, b))
ReDim v(UBound(u))

For Each c In b
    u(c) = True
Next

For Each c In a
     If Not u(c) Then v(c) = True
Next

q = "Missing from Sheet2 ..." & vbLf
For c = 1 To UBound(v)
    If v(c) Then q = q & c & vbLf
Next

MsgBox q

End Sub
 

Forum statistics

Threads
1,081,969
Messages
5,362,484
Members
400,677
Latest member
champchamp

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top