Two Sheets Two Column Comparing

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>
 

ayazgreat

Well-known Member
Joined
Jan 19, 2008
Messages
1,151
But Sir
You can try please as for a week I have been finding solution for it
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
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:

ayazgreat

Well-known Member
Joined
Jan 19, 2008
Messages
1,151
Thank you very much Mick for your reply, let me check these code and get back to you
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
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
 

Watch MrExcel Video

Forum statistics

Threads
1,129,278
Messages
5,635,256
Members
416,850
Latest member
Sidddharth

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
Top