Two Sheets Two Column Comparing

A

ayazgreat

Well-known Member
Joined
Jan 19, 2008
Messages
1,151
Hi All

After searching a lot , I did not find any solution here and on web, Actual I would like to compare sheet1 a col with sheet2 a col and copy result on sheet "Comparing Result" both comparing sheets several duplicate values, I don't want to remove duplicates values when copying result , Please go through below detail of sheet "Comparing Result"

Comparing Result

ABCD
1Inclusive all repeated values in both sheets Inclusive all repeated values which are not in sheet1Inclusive all repeated values which are not in sheet2
2Values in Sheet1 & Sheet2 Value Not in Sheet1Value Not in Sheet2
31345 58974789
41356 1345
51234 4789
61345 1234
71652
84789
91345
101789

<colgroup><col style="width: 30px; font-weight: bold;"><col style="width: 281px;"><col style="width: 64px;"><col style="width: 339px;"><col style="width: 339px;"></colgroup><tbody>
</tbody>

Sheet1

A
1List A
21345
31356
44789
51234
61345
71652
84789
91345
101789

<colgroup><col style="width: 30px; font-weight: bold;"><col style="width: 64px;"></colgroup><tbody>
</tbody>

Sheet2

A
1List B
21345
31356
45897
51234
61345
71652
84789
91345
101789
111345
124789
131234

<colgroup><col style="width: 30px; font-weight: bold;"><col style="width: 64px;"></colgroup><tbody>
</tbody>
 
Sort by date Sort by votes

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Try this:-
Though I think 4789 is misplaced in your data results.
Results start columns "C ,D & E".
NB:- Clear "Remmed" code lines to show table of number count, starting Column "G".
Code: 
[COLOR=navy]Sub[/COLOR] MG20Mar22
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] K [COLOR=navy]As[/COLOR] Variant, Q [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant, Dic [COLOR=navy]As[/COLOR] Object, Sht1 [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Sht2 [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] oMax [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] a [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] b [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
    [COLOR=navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
        Ray = Array("sheet1", "sheet2")
            [COLOR=navy]For[/COLOR] Ac = 0 To 1
                [COLOR=navy]With[/COLOR] Sheets(Ray(Ac))
                    [COLOR=navy]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
                [COLOR=navy]End[/COLOR] With
                [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
                    [COLOR=navy]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
                        Sht1 = 0: Sht2 = 0
                        [COLOR=navy]If[/COLOR] Ac = 0 [COLOR=navy]Then[/COLOR] Sht1 = 1 Else Sht2 = 1
                            Dic.Add Dn.Value, Array(Sht1, Sht2)
                        [COLOR=navy]Else[/COLOR]
                            Q = Dic(Dn.Value)
                                [COLOR=navy]If[/COLOR] Ac = 0 [COLOR=navy]Then[/COLOR]
                                    Q(0) = Q(0) + 1
                                [COLOR=navy]Else[/COLOR]
                                    Q(1) = Q(1) + 1
                                [COLOR=navy]End[/COLOR] If
                             Dic(Dn.Value) = Q
                        [COLOR=navy]End[/COLOR] If
                [COLOR=navy]Next[/COLOR] Dn
        [COLOR=navy]Next[/COLOR] Ac
[COLOR=navy]Dim[/COLOR] x
ReDim Ray(1 To Rng.Count, 1 To 3)
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] Dic.keys
    '[COLOR=green][B]These next 2 lines shows the results in table form starting "G1"[/B][/COLOR]
    '[COLOR=green][B]x = x + 1[/B][/COLOR]
    '[COLOR=green][B]Cells(x, "G") = K: Cells(x, "H") = Dic(K)(0): Cells(x, "I") = Dic(K)(1)[/B][/COLOR]
    
    [COLOR=navy]If[/COLOR] Dic(K)(0) > 0 And Dic(K)(1) > 0 [COLOR=navy]Then[/COLOR]
        c = c + 1
        Ray(c, 1) = K
    [COLOR=navy]End[/COLOR] If
    [COLOR=navy]If[/COLOR] Dic(K)(0) < Dic(K)(1) [COLOR=navy]Then[/COLOR]
        a = a + 1
        Ray(a, 2) = K
    [COLOR=navy]End[/COLOR] If
    [COLOR=navy]If[/COLOR] Dic(K)(0) > Dic(K)(1) [COLOR=navy]Then[/COLOR]
        b = b + 1
        Ray(b, 3) = K
    [COLOR=navy]End[/COLOR] If
   oMax = Application.Max(a, b, c)
[COLOR=navy]Next[/COLOR] K
Range("C1").Resize(oMax, 3).Value = Ray

[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
This code is basically the same but provides headers in column "C to E", sort of defines the criteria used !!
Code: 
[COLOR="Navy"]Sub[/COLOR] MG21Mar54
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, Dic [COLOR="Navy"]As[/COLOR] Object, Sht1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sht2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] a [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] b [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
        Ray = Array("sheet1", "sheet2")
            [COLOR="Navy"]For[/COLOR] Ac = 0 To 1
                [COLOR="Navy"]With[/COLOR] Sheets(Ray(Ac))
                    [COLOR="Navy"]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
                [COLOR="Navy"]End[/COLOR] With
                [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
                    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                        Sht1 = 0: Sht2 = 0
                        [COLOR="Navy"]If[/COLOR] Ac = 0 [COLOR="Navy"]Then[/COLOR] Sht1 = 1 Else Sht2 = 1
                            Dic.Add Dn.Value, Array(Sht1, Sht2)
                        [COLOR="Navy"]Else[/COLOR]
                            Q = Dic(Dn.Value)
                                [COLOR="Navy"]If[/COLOR] Ac = 0 [COLOR="Navy"]Then[/COLOR]
                                    Q(0) = Q(0) + 1
                                [COLOR="Navy"]Else[/COLOR]
                                    Q(1) = Q(1) + 1
                                [COLOR="Navy"]End[/COLOR] If
                             Dic(Dn.Value) = Q
                        [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]Next[/COLOR] Dn
        [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Dim[/COLOR] x
ReDim Ray(1 To Rng.Count, 1 To 3)
Ray(1, 1) = "Sht1/Sht2 count > 0": Ray(1, 2) = "Sht1 count < sht2 count ": Ray(1, 3) = "sht1 Count > sht2 count"
a = 1: b = 1: c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
    '[COLOR="Green"][B]These next 2 lines shows the results in atble form starting "G1"[/B][/COLOR]
    x = x + 1
    Cells(x, "G") = K: Cells(x, "H") = Dic(K)(0): Cells(x, "I") = Dic(K)(1)
    
    [COLOR="Navy"]If[/COLOR] Dic(K)(0) > 0 And Dic(K)(1) > 0 [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        Ray(c, 1) = K
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]If[/COLOR] Dic(K)(0) < Dic(K)(1) [COLOR="Navy"]Then[/COLOR]
        a = a + 1
        Ray(a, 2) = K
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]If[/COLOR] Dic(K)(0) > Dic(K)(1) [COLOR="Navy"]Then[/COLOR]
        b = b + 1
        Ray(b, 3) = K
    [COLOR="Navy"]End[/COLOR] If
   oMax = Application.Max(a, b, c)
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]With[/COLOR] Range("C1").Resize(oMax, 3)
    .Value = Ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question
Time value to contain Months/Date/Year Hour:Minutes:Seconds AM/PM
Replies
4
Views
599
hsandeep
H
H
  • Question
Value corresponding to flag cell
Replies
5
Views
820
Fluff
Fluff
H
  • Question
Code needed for Max & Min Values
2 3 4
Replies
37
Views
3K
hsandeep
H
H
  • Question
Multiple IF
2
Replies
13
Views
1K
TAPS_MikeDion
TAPS_MikeDion
H
  • Question
Increase OR Decrease the complete value
Replies
3
Views
648
joeu2004
J

Forum statistics

Threads
1,214,606
Messages
6,120,479
Members
448,967
Latest member
visheshkotha

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