removing duplicate repeatative data

[sharmaaishads]

I have worksheets named WS1 and WS2. I need to compare Column C of WS1 with Column D of WS2. If both columns contain same values then I need to highlight both the cells of "Column C of WS1" and "Column D of WS2". Example: Column C of WS1 500,000.00 260,000.00 65,000.00 30,000.00 46,104.00 530,000.00 350,000.00 55,000.00 7,000.00 2,520.16 30,000.00 210,000.00 650,000.00 10,000.00 Column D of WS2 2520.16 500,000.00 260,000.00 65,000.00 30,000.00 46,104.00 530,000.00 350,000.00 55,000.00 7,000.00 30,000.00 1,827,099.63 10,000.00 If values of Column C = Value of Column D then the cell containing same values in both columns is highlighted. My data is not uniform. They may have repetitive values. I am doing it manually right now and it is time-consuming as I have a lot of data to work on. Can you please suggest me. I am looking for exact matches for currency amounts and also I want the amounts which has been already matched to be left out. The value in each cell should be matched with only one value of another cell. Leave out the next repeated value to match with next.

<tbody>
</tbody>

 

[SteveO59L]

so, for duplicates, do you want each value highlighted?

 

[sharmaaishads]

either highlighted or removed from both the columns..

 

[MickG]

Try this for Column "C" of "Ws1" & Column "D" of "Ws2"
Paired duplicate values coloured VbYellow.

[COLOR="Navy"]Sub[/COLOR] MG09Jan48
[COLOR="Navy"]Dim[/COLOR] Rng1 [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oMax, Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Rng2 [COLOR="Navy"]As[/COLOR] Range, Ray [COLOR="Navy"]As[/COLOR] Variant, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] nn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("WS1")
    [COLOR="Navy"]Set[/COLOR] Rng1 = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("WS2")
    [COLOR="Navy"]Set[/COLOR] Rng2 = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
Ray = Array(Rng1, Rng2)
    oMax = Application.Max(Rng1.Count, Rng2.Count)
        [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
            .CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] Ac = 0 To 1
       [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Ray(Ac)
            [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                ReDim nRay(1 To oMax, 1 To 2)
                [COLOR="Navy"]If[/COLOR] Ac = 0 [COLOR="Navy"]Then[/COLOR]
                  n = 1
                  [COLOR="Navy"]Set[/COLOR] nRay(n, 1) = Dn
                [COLOR="Navy"]Else[/COLOR]
                   nn = 1
                   [COLOR="Navy"]Set[/COLOR] nRay(1, 2) = Dn
                [COLOR="Navy"]End[/COLOR] If
            .Add Dn.Value, Array(nRay, n, nn)
            [COLOR="Navy"]Else[/COLOR]
                Q = .Item(Dn.Value)
                  
                  [COLOR="Navy"]If[/COLOR] Ac = 0 [COLOR="Navy"]Then[/COLOR]
                      Q(1) = Q(1) + 1
                      [COLOR="Navy"]Set[/COLOR] Q(0)(Q(1), 1) = Dn
                   [COLOR="Navy"]Else[/COLOR]
                      Q(2) = Q(2) + 1
                      [COLOR="Navy"]Set[/COLOR] Q(0)(Q(2), 2) = Dn
                    [COLOR="Navy"]End[/COLOR] If
               .Item(Dn.Value) = Q
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Dn
        [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, nMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
  nMax = Application.Max(.Item(K)(1), .Item(K)(2))
    [COLOR="Navy"]For[/COLOR] n = 1 To nMax
        [COLOR="Navy"]If[/COLOR] .Item(K)(0)(n, 1) = .Item(K)(0)(n, 2) [COLOR="Navy"]Then[/COLOR]
              .Item(K)(0)(n, 1).Interior.Color = vbYellow
              .Item(K)(0)(n, 2).Interior.Color = vbYellow
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[MickG]

If you want to remove those Pairs try This:-

[COLOR="Navy"]Sub[/COLOR] MG09Jan53
'[COLOR="Green"][B]Mk2[/B][/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng1 [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oMax, Q [COLOR="Navy"]As[/COLOR] Variant, RngC [COLOR="Navy"]As[/COLOR] Range, RngD [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng2 [COLOR="Navy"]As[/COLOR] Range, Ray [COLOR="Navy"]As[/COLOR] Variant, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] nn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("WS1")
    [COLOR="Navy"]Set[/COLOR] Rng1 = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("WS2")
    [COLOR="Navy"]Set[/COLOR] Rng2 = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
Ray = Array(Rng1, Rng2)
    oMax = Application.Max(Rng1.Count, Rng2.Count)
        [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
            .CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] Ac = 0 To 1
       nn = 0
       [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Ray(Ac)
            [COLOR="Navy"]If[/COLOR] Not .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                ReDim nRay(1 To oMax, 1 To 2)
                  [COLOR="Navy"]Set[/COLOR] nRay(1, Ac + 1) = Dn
                .Add Dn.Value, Array(nRay, 1, nn)
            [COLOR="Navy"]Else[/COLOR]
                Q = .Item(Dn.Value)
                  
                  [COLOR="Navy"]If[/COLOR] Ac = 0 [COLOR="Navy"]Then[/COLOR]
                      Q(1) = Q(1) + 1
                      [COLOR="Navy"]Set[/COLOR] Q(0)(Q(1), Ac + 1) = Dn
                   [COLOR="Navy"]Else[/COLOR]
                      Q(2) = Q(2) + 1
                      [COLOR="Navy"]Set[/COLOR] Q(0)(Q(2), Ac + 1) = Dn
                    [COLOR="Navy"]End[/COLOR] If
               .Item(Dn.Value) = Q
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Dn
        [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant, nMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] .Keys
  nMax = Application.Max(.Item(k)(1), .Item(k)(2))
    [COLOR="Navy"]For[/COLOR] n = 1 To nMax
        [COLOR="Navy"]If[/COLOR] .Item(k)(0)(n, 1) = .Item(k)(0)(n, 2) [COLOR="Navy"]Then[/COLOR]
              .Item(k)(0)(n, 1).Delete shift:=xlUp
              .Item(k)(0)(n, 2).Delete shift:=xlUp
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[sharmaaishads]

thank you

 

[MickG]

You're welcome