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

M

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!
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
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
 
Upvote 0
Mann750,

Sample raw data worksheets:


Excel 2007
A
11
22
31
45
55
62
73
85
94
10
Sheet1



Excel 2007
A
12
23
33
44
53
64
7
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).

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.
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
Mann750,

Will the Exit Sub stop the whole module running through the different procedures?
Click to expand...

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:
Upvote 0
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:
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
VBA to Insert Mismatched Row in separate worksheet
2 3
Replies
21
Views
648
Peter_SSs
Peter_SSs
K
  • Solved
Can't get vlookup or index/match to work in compare
Replies
6
Views
388
KDS14589
K
B
  • Solved
OPTIMIZE my code
Replies
5
Views
295
BritsBlitz
B
H
  • Question Question
Using XLOOKUP in VBA to lookup value underneath specific header name (columns can change depending on worksheet)
Replies
0
Views
62
Hailee994
H
S
  • Question Question
Macro to compare two sheets with identical column headers and first column, then showing all table differences in third sheet
Replies
1
Views
177
DanteAmor
DanteAmor

Forum statistics

Threads
1,223,227
Messages
6,170,853
Members
452,361
Latest member
d3ad3y3

Share this page

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