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:

Industry	Sub-Industry	Sub-Sub-Industry		Industry	Sub-Industry	Sub-Sub-Industry
AAA	BBB	CCC		DDD	BBB	FFF
AAA	BBB	PPP		AAA	BBB	CCC
DDD	BBB	EEE		AAA	BBB	PPP
XXX	YYY	UUU		DDD	BBB	EEE
OOO	RRR	TTT		XXX	YYY	ZZZ
				XXX	YYY	UUU
				OOO	PPP	QQQ

<tbody>
</tbody>

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

Industry	Sub-Industry	Sub-Sub-Industry
DDD	BBB	FFF
XXX	YYY	ZZZ
OOO	PPP	QQQ

<tbody>
</tbody>

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