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

fxrexcel

New Member
Joined
Aug 11, 2018
Messages
18
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:
IndustrySub-IndustrySub-Sub-IndustryIndustrySub-IndustrySub-Sub-Industry
AAABBBCCCDDDBBBFFF
AAABBBPPPAAABBBCCC
DDDBBBEEEAAABBBPPP
XXXYYYUUUDDDBBBEEE
OOORRRTTTXXXYYYZZZ
XXXYYYUUU
OOOPPPQQQ

<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

IndustrySub-IndustrySub-Sub-Industry
DDDBBBFFF
XXXYYYZZZ
OOOPPPQQQ

<tbody>
</tbody>

Thanks for your help!
 

Some videos you may like

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Your ranges start Column "A" & Column "E" with results starting column "I".
Code:
[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
 

Watch MrExcel Video

Forum statistics

Threads
1,108,523
Messages
5,523,370
Members
409,514
Latest member
MarkZuckerberg

This Week's Hot Topics

Top