VBA - Comparing two lists with multiple columns and returning mismatches in another range

[fxrexcel]

I have the following problem that I need to solve with VBA:

I have two lists in the same sheet with 3 columns each with multiple rows (about 100). I would like to compare both lists and return the mismatches in another range in the same sheet.

The second list is the master list and the Shorter List is a subset of the Master List.

BEFORE

Shorter List: Master List:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Industry[/TD]
[TD]Sub-Industry[/TD]
[TD]Sub-Sub-Industry[/TD]
[TD][/TD]
[TD]Industry[/TD]
[TD]Sub-Industry[/TD]
[TD]Sub-Sub-Industry[/TD]
[/TR]
[TR]
[TD]AAA[/TD]
[TD]BBB[/TD]
[TD]CCC[/TD]
[TD][/TD]
[TD]DDD[/TD]
[TD]BBB[/TD]
[TD]FFF[/TD]
[/TR]
[TR]
[TD]AAA[/TD]
[TD]BBB[/TD]
[TD]PPP[/TD]
[TD][/TD]
[TD]AAA[/TD]
[TD]BBB[/TD]
[TD]CCC[/TD]
[/TR]
[TR]
[TD]DDD[/TD]
[TD]BBB[/TD]
[TD]EEE[/TD]
[TD][/TD]
[TD]AAA[/TD]
[TD]BBB[/TD]
[TD]PPP[/TD]
[/TR]
[TR]
[TD]XXX[/TD]
[TD]YYY[/TD]
[TD]UUU[/TD]
[TD][/TD]
[TD]DDD[/TD]
[TD]BBB[/TD]
[TD]EEE[/TD]
[/TR]
[TR]
[TD]OOO[/TD]
[TD]RRR[/TD]
[TD]TTT[/TD]
[TD][/TD]
[TD]XXX[/TD]
[TD]YYY[/TD]
[TD]ZZZ[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]XXX[/TD]
[TD]YYY[/TD]
[TD]UUU[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]OOO[/TD]
[TD]PPP[/TD]
[TD]QQQ[/TD]
[/TR]
</tbody>[/TABLE]


AFTER

• this has to be written next to the Master List on the same sheet
• these are all the mismatches, i.e. industries that are not in the shorter list

[TABLE="width: 500"]
<tbody>[TR]
[TD]Industry[/TD]
[TD]Sub-Industry[/TD]
[TD]Sub-Sub-Industry[/TD]
[/TR]
[TR]
[TD]DDD[/TD]
[TD]BBB[/TD]
[TD]FFF[/TD]
[/TR]
[TR]
[TD]XXX[/TD]
[TD]YYY[/TD]
[TD]ZZZ[/TD]
[/TR]
[TR]
[TD]OOO[/TD]
[TD]PPP[/TD]
[TD]QQQ[/TD]
[/TR]
</tbody>[/TABLE]

Thanks for your help!

 

[MickG]

Your ranges start Column "A" & Column "E" with results starting column "I".

[COLOR="Navy"]Sub[/COLOR] MG13Aug38
 [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] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray()
    [COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
        [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
            .CompareMode = vbTextCompare
            c = 1
            ReDim Ray(1 To 3, 1 To 1)
            Ray(1, 1) = "Industry": Ray(2, 1) = "Sub-Industry": Ray(3, 1) = "Sub-Sub-Industry"
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            Txt = Dn.Value & Dn.Offset(, 1).Value & Dn.Offset(, 2).Value
            .Item(Txt) = Empty
        [COLOR="Navy"]Next[/COLOR]
        [COLOR="Navy"]Set[/COLOR] Rng = Range("E2", Range("E" & Rows.Count).End(xlUp))
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
                Txt = Dn.Value & Dn.Offset(, 1).Value & Dn.Offset(, 2).Value
                    [COLOR="Navy"]If[/COLOR] Not .exists(Txt) [COLOR="Navy"]Then[/COLOR]
                        c = c + 1
                        ReDim Preserve Ray(1 To 3, 1 To c)
                            Ray(1, c) = Dn.Value
                            Ray(2, c) = Dn.Offset(, 1).Value
                            Ray(3, c) = Dn.Offset(, 2).Value
                    [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] Dn
Range("I1").Resize(c, 3) = Application.Transpose(Ray)
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[fxrexcel]

Works perfectly, thanks!

 

[MickG]

You're welcome