VBA find matching ID then compare other values in row

[Kinjal Doshi]

To hiker95

I went through your earlier post - https://www.mrexcel.com/forum/excel...atching-id-then-compare-other-values-row.html

It was very helpful.. but it works only on 6th column. My requirement is that it works in all the columns that my excel sheet has... please check if you can help me out...

Thanks
Kinjal.

 

[hiker95]

Kinjal Doshi,

Welcome to the MrExcel forum.

So that we can get it right on the first try, it would help if we could see your actual raw data workbook/worksheets.

And, on another worksheet what the results (manually formatted by you) should look like.


Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data.

 

[Kinjal Doshi]

Hi Hiker,

Please find below link
https://app.box.com/s/plqpa11n6p0qqpvbgegz0oc4x5w5gwln

I have given a sample of 4 columns only... My actual spreadsheet has columns till AM... so would request you to write me a VBA for columns till AM.

I want to highlight the differences in Sheet 2 as per the sample sheet.

Looking forward to your soonest reply


Regards
Kinjal


Welcome to the MrExcel forum.

So that we can get it right on the first try, it would help if we could see your actual raw data workbook/worksheets.

And, on another worksheet what the results (manually formatted by you) should look like.


Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data.[/QUOTE]

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG29Jun06
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng2 [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng: [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Dn: [COLOR="Navy"]Next[/COLOR]
    
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng2 = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng2
    [COLOR="Navy"]If[/COLOR] .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] ac = 1 To 39
           [COLOR="Navy"]If[/COLOR] Not .Item(Dn.Value).Offset(, ac).Value = Dn.Offset(, ac).Value [COLOR="Navy"]Then[/COLOR]
                Dn.Offset(, ac).Font.Color = vbRed
           [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] ac
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Kinjal Doshi]

Hi Mick,

Thanks for the fast reply....

It works perfectly.... but I missed to mention.. what If my columns are changed as per below link (shifted gender column)... My sheet 2 will have columns interchanged... is it possible to write a VBA that will check ID's in column A and highlight differences in all the columns even if they are not aligned in the same way that is in sheet 1? Secondly it highlights the lower case values where there is no difference in spellings... is it possible to highlight only the actual difference?

https://app.box.com/s/plqpa11n6p0qqpvbgegz0oc4x5w5gwln

Sorry for the inconvenience caused.... I should have mentioned my requirement clearly in first go.

Waiting for your soonest reply

Regards
Kinjal

 

[MickG]

Try This:-

[COLOR="Navy"]Sub[/COLOR] MG29Jun48
'[COLOR="Green"][B]Code2[/B][/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng2 [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant

[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
      [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]
                [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]For[/COLOR] ac = 1 To 39
                    Dic(Dn.Value).Add .Range("A1").Offset(, ac).Value, _
                    Intersect(Dn.EntireRow, .Range("A1").Offset(, ac).EntireColumn)
                [COLOR="Navy"]Next[/COLOR] ac
     [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng2 = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng2
    [COLOR="Navy"]For[/COLOR] ac = 1 To 39
     [COLOR="Navy"]If[/COLOR] Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
       [COLOR="Navy"]If[/COLOR] Dic(Dn.Value).exists(.Range("A1").Offset(, ac).Value) [COLOR="Navy"]Then[/COLOR]
         Q = UCase(Dic(Dn.Value).Item(.Range("A1").Offset(, ac).Value))
          [COLOR="Navy"]If[/COLOR] Not Q = UCase(Intersect(Dn.EntireRow, .Range("A1").Offset(, ac).EntireColumn)) [COLOR="Navy"]Then[/COLOR]
                Intersect(Dn.EntireRow, .Range("A1").Offset(, ac).EntireColumn).Font.Color = vbRed
          [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
     [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]Next[/COLOR] ac
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Kinjal Doshi]

Hi Mick,

It works perfectly fine... thanks a lot!!


Regards
Kinjal

 

[MickG]

You're welcome

 

[Kinjal Doshi]

Hi Mick,

The macro was working fine till now... but when I run it again... It calculates up to few rows and gives right results and then throws and error saying Type Mismatch.... I tried to figure out every possible way but still I am not able to solve this error... could you please let me know... what do I do...? I have checked number formats in both the files... it is correct and the number in column A of sheet 2 is also in column A of sheet 1.. but still it is throwing error...

Awaiting your soonest reply
Kinjal Doshi

 

[Kinjal Doshi]

I have kept a sample at below link
https://app.box.com/s/qp3yfrjykc9r49lt92gvaoxcqv3fhvd0