Sorting and Matching Multiple Columns

B

bmpreston

Board Regular
Joined
Jun 18, 2016
Messages
120
Office Version
  1. 365
Platform
  1. MacOS
Hello to all,

I'm trying to side-by-side match two sets of data. Each set of data is multiple rows long, around 3000. The data is in 3 columns, and another 3 columns needs to be matched.

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Header 1[/TD]
[TD]Header 2[/TD]
[TD]Header 3[/TD]
[TD]Spacer[/TD]
[TD]Header A1[/TD]
[TD]Header A2[/TD]
[TD]Header A3[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD][/TD]
[TD]2[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]data[/TD]
[TD]data[/TD]
[TD][/TD]
[TD]3[/TD]
[TD]data[/TD]
[TD]data[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]data[/TD]
[TD]data[/TD]
[TD][/TD]
[TD]4[/TD]
[TD]data[/TD]
[TD]data[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]data[/TD]
[TD]data[/TD]
[TD][/TD]
[TD]8[/TD]
[TD]data[/TD]
[TD]data[/TD]
[/TR]
</tbody>[/TABLE]


This gives:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Header 1[/TD]
[TD]Header 2[/TD]
[TD]Header 3[/TD]
[TD]Spacer[/TD]
[TD]Header A1[/TD]
[TD]Header A2[/TD]
[TD]Header A3[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD][/TD]
[TD]2[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]3[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD][/TD]
[TD]4[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]8[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[/TR]
</tbody>[/TABLE]


I have researched online, and found some VBA, can't seem to get them to work. When I try, it seems to just delete all my data. Those links I've since lost, but any way to relatively quickly process this data through would be great.

Thanks
 
Sort by date Sort by votes
This code works now, because previously the code was not reading all of column "E", BUT when I first ran the altered code it kept failing on "Al.sort". I traced this down to line 2438 Sheet1 and found if I physically replaced the Number "100626784" (re-typed)the code would work. I think you will have to do the same !!!
I don't know why.
Give it a try.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG10Sep19
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, AL [COLOR="Navy"]As[/COLOR] Object, Ray [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng1 [COLOR="Navy"]As[/COLOR] Range, Rng2 [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng1 = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Rng2 = Range("E4", Range("E" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Rng = Union(Rng1, Rng2)
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
[COLOR="Navy"]Set[/COLOR] AL = CreateObject("System.Collections.ArrayList")

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not AL.Contains(Dn.Value) [COLOR="Navy"]Then[/COLOR] AL.Add Dn.Value
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
    AL.Sort: Ray = AL.ToArray
    ReDim nRay(1 To UBound(Ray) + 2, 1 To 7)
    nRay(1, 1) = Cells(1, 1): nRay(1, 2) = Cells(1, 2): nRay(1, 3) = Cells(1, 3)
    nRay(1, 5) = Cells(1, 5): nRay(1, 6) = Cells(1, 6): nRay(1, 7) = Cells(1, 7)
    c = 1
    
  [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Ray)
        c = c + 1
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] .Item(Ray(n))
            nRay(c, R.Column) = .Item(Ray(n)).Value
            nRay(c, R.Column + 1) = .Item(Ray(n)).Offset(, 1).Value
            nRay(c, R.Column + 2) = .Item(Ray(n)).Offset(, 2).Value
        [COLOR="Navy"]Next[/COLOR] R
   [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 7)
    .Value = nRay
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick






[TABLE="width: 89"]
<colgroup><col width="118" style="width: 89pt; mso-width-source: userset; mso-width-alt: 4209;"> <tbody>[TR]
[TD="width: 118, bgcolor: transparent"][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Ok. This seems to have worked at first, but when I did a spot check against just one random number, its not on the new sheet. I don't have any way of telling how many else don't come over....

How can we check that?

Item in question is 100517484... This didn't come to the new Sheet2.

Thanks
 
Upvote 0
I think its because these numbers are duplicates,100517484 shows twice in column "A" and once in Column"E"
There are at least 15 duplicates in column "A" in some case the related data is different. There are none in column "E"
How would you line to deal with these numbers
Here is a bit of code to see them in sheet1.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG10Sep26
[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]
[COLOR="Navy"]Dim[/COLOR] Rng1 [COLOR="Navy"]As[/COLOR] Range, Rng2 [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng1 = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Rng2 = Range("E4", Range("E" & Rows.Count).End(xlUp))

Ray = Array(Rng1, Rng2)
[COLOR="Navy"]For[/COLOR] n = 0 To 1
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
     [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Ray(n)
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            .Add Dn.Value, ""
        [COLOR="Navy"]Else[/COLOR]
            MsgBox Dn.Select
        [COLOR="Navy"]End[/COLOR] If
     [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
I have that code from somewhere that I ran just against the first column. Now I’m hoping to incorporate them.... I was hoping it would just list the duplicates and unless the right side also had duplicates (it doesn’t) then it wouldn’t be match.

Basically, I’m trying to provide this as evidence that there are items that don’t have matches. Then show that some numbers are duplicated. Finally if they have matches... if the third columns match... in some cases they don’t. I’m using this as evidence that someone needs desperately to audit their system...

thanks

[TABLE="width: 500"]
<tbody>[TR]
[TD]1[/TD]
[TD]name[/TD]
[TD]name[/TD]
[TD]Spacer[/TD]
[TD]1[/TD]
[TD]name[/TD]
[TD]name[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD](duplicate)[/TD]
[TD]name[/TD]
[TD]Spacer[/TD]
[TD][/TD]
[TD](blank because it doesn’t have a known duplicate)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]name[/TD]
[TD]name[/TD]
[TD]Spacer[/TD]
[TD]2[/TD]
[TD]name[/TD]
[TD]name[/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Upvote 0
This code should now work for Possible duplicates in column "A", and no duplicates in column "E".
Code: 
[COLOR=navy]Sub[/COLOR] MG11Sep50
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, AL [COLOR=navy]As[/COLOR] Object, Ray [COLOR=navy]As[/COLOR] Variant, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Fd [COLOR=navy]As[/COLOR] Boolean
[COLOR=navy]Dim[/COLOR] Rng1 [COLOR=navy]As[/COLOR] Range, Rng2 [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] R [COLOR=navy]As[/COLOR] Range, Rw [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] G [COLOR=navy]As[/COLOR] Range, p [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Set[/COLOR] Rng1 = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]Set[/COLOR] Rng2 = Range("E4", Range("E" & Rows.Count).End(xlUp))
[COLOR=navy]Set[/COLOR] Rng = Union(Rng1, Rng2)
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
[COLOR=navy]Set[/COLOR] AL = CreateObject("System.Collections.ArrayList")
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Not AL.Contains(Dn.Value) [COLOR=navy]Then[/COLOR] AL.Add Dn.Value
    [COLOR=navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
        .Add Dn.Value, Dn
    [COLOR=navy]Else[/COLOR]
        [COLOR=navy]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dn
    AL.Sort: Ray = AL.ToArray
    ReDim nRay(1 To UBound(Ray) * 2, 1 To 7)
    nRay(1, 1) = Cells(1, 1): nRay(1, 2) = Cells(1, 2): nRay(1, 3) = Cells(1, 3)
    nRay(1, 5) = Cells(1, 5): nRay(1, 6) = Cells(1, 6): nRay(1, 7) = Cells(1, 7)
    c = 1
  [COLOR=navy]For[/COLOR] n = 0 To UBound(Ray)
     p = 0
        [COLOR=navy]If[/COLOR] .Item(Ray(n)).Areas(1).Count > 1 [COLOR=navy]Then[/COLOR]
           [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] G [COLOR=navy]In[/COLOR] .Item(Ray(n)).Areas(1)
                c = c + 1
                p = p + 1
                nRay(c, 1) = G
                nRay(c, 2) = G.Offset(, 1)
                nRay(c, 3) = G.Offset(, 2)
                [COLOR=navy]If[/COLOR] .Item(Ray(n)).Areas(2).Count = p [COLOR=navy]Then[/COLOR]
                        nRay(c, 5) = .Item(Ray(n)).Areas(2)
                        nRay(c, 6) = .Item(Ray(n)).Areas(2).Offset(, 1)
                        nRay(c, 7) = .Item(Ray(n)).Areas(2).Offset(, 2)
                [COLOR=navy]End[/COLOR] If
            [COLOR=navy]Next[/COLOR] G
        [COLOR=navy]Else[/COLOR]
        c = c + 1
        
        [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] R [COLOR=navy]In[/COLOR] .Item(Ray(n))
            nRay(c, R.Column) = .Item(Ray(n)).Value
            nRay(c, R.Column + 1) = .Item(Ray(n)).Offset(, 1).Value
            nRay(c, R.Column + 2) = .Item(Ray(n)).Offset(, 2).Value
        [COLOR=navy]Next[/COLOR] R
   
   [COLOR=navy]End[/COLOR] If
   [COLOR=navy]Next[/COLOR] n
[COLOR=navy]End[/COLOR] With

[COLOR=navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 7)
    .Value = nRay
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
Excel 2016 VBA - Pull data from multiple sheets to One with specificities
Replies
3
Views
325
mumps
mumps
A
  • Question Question
populate data based on Matching headers for multiple sheets across files
Replies
0
Views
193
Amer Omar
A
L
  • Question Question
VBA to copy data based on column data to multiple files
Replies
9
Views
447
LyonDer
L
G
  • Solved
Find partial text match and then list out the header row for the match
Replies
3
Views
167
Cubist
Cubist
M
  • Question Question
VBA Subtotal 47,000+ Rows
Replies
1
Views
236
igold
igold

Forum statistics

Threads
1,224,041
Messages
6,176,041
Members
452,698
Latest member
MikaVmex

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top