Macro help needed; highlighting change in attributes in 2 sheets

[Talonspell]

Greetings!

I need some help here with a problem I have. Any help would be much appreciated!

I have the following table in Sheet 1. This is the master list. The Name is the unique identifier.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Mood[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]Happy[/TD]
[/TR]
[TR]
[TD]Betty[/TD]
[TD]Sad[/TD]
[/TR]
[TR]
[TD]James[/TD]
[TD]Angry[/TD]
[/TR]
[TR]
[TD]Peter[/TD]
[TD]Angry [/TD]
[/TR]
[TR]
[TD]Carl[/TD]
[TD]Sad[/TD]
[/TR]
</tbody>[/TABLE]


I have another table in Sheet 2. It is essentially the same thing, except that the names are now in a random order, and the moods of some of the people have changed.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Mood[/TD]
[/TR]
[TR]
[TD]Betty[/TD]
[TD]Angry[/TD]
[/TR]
[TR]
[TD]Peter[/TD]
[TD]Happy[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]Happy[/TD]
[/TR]
[TR]
[TD]Carl[/TD]
[TD]Sad[/TD]
[/TR]
[TR]
[TD]James[/TD]
[TD]Sad[/TD]
[/TR]
</tbody>[/TABLE]

So basically, what I need help with, is a macro that would look at the list of people and their moods in Sheet 2, compare it with the list in Sheet 1, and if there is a change in moods, that particular person in Sheet 1 will be highlighted. That is the first macro I need help with.

The second macro is I need help with is similar to the one above, except that rather than just highlighting the person with the change in mood, I need it to take the mood change in Sheet 2, and update it accordingly to the corresponding person in Sheet 1.

Thanks in advance!


P.S I am using Excel 2010.

 

[MickG]

This code should cover both of your requirements.

[COLOR="Navy"]Sub[/COLOR] MG30Aug20
[COLOR="Navy"]Dim[/COLOR] Rng1            [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"]Integer[/COLOR]
    [COLOR="Navy"]Dim[/COLOR] Rng2            [COLOR="Navy"]As[/COLOR] Range
    [COLOR="Navy"]Dim[/COLOR] Dic             [COLOR="Navy"]As[/COLOR] Object
    [COLOR="Navy"]Dim[/COLOR] Ray             [COLOR="Navy"]As[/COLOR] Variant
    [COLOR="Navy"]Dim[/COLOR] k               [COLOR="Navy"]As[/COLOR] Variant
    [COLOR="Navy"]Dim[/COLOR] c               [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    
    [COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
        [COLOR="Navy"]Set[/COLOR] Rng1 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
    [COLOR="Navy"]End[/COLOR] With
    [COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
        [COLOR="Navy"]Set[/COLOR] Rng2 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
    [COLOR="Navy"]End[/COLOR] With
    [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng1: [COLOR="Navy"]Set[/COLOR] Dic.Item(Dn.Value) = Dn: [COLOR="Navy"]Next[/COLOR] Dn
   
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng2
           [COLOR="Navy"]If[/COLOR] Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]If[/COLOR] Not Dic.Item(Dn.Value).Offset(, 1) = Dn.Offset(, 1) [COLOR="Navy"]Then[/COLOR]
                    [COLOR="Navy"]With[/COLOR] Dic.Item(Dn.Value)
                        .Offset(, 1).Font.ColorIndex = 3
                        .Offset(, 1).Value = Dn.Offset(, 1).Value
                    [COLOR="Navy"]End[/COLOR] With
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn


[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Talonspell]

Excellent stuff Mick. Works great. A million hats off to you, sir!

 

[MickG]

You're welcome