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.

Header 1Header 2Header 3SpacerHeader A1Header A2Header A3
1DataData2DataData
2datadata3datadata
4datadata4datadata
6datadata8datadata

<tbody>
</tbody>


This gives:

Header 1Header 2Header 3SpacerHeader A1Header A2Header A3
1DataData
2DataData2DataData
3DataData
4DataData4DataData
6DataData
8DataData

<tbody>
</tbody>


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






<colgroup><col width="118" style="width: 89pt; mso-width-source: userset; mso-width-alt: 4209;"> <tbody> </tbody>
 
Upvote 0

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
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

1namenameSpacer1namename
1(duplicate)nameSpacer(blank because it doesn’t have a known duplicate)
2namenameSpacer2namename

<tbody>
</tbody>
 
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

A
  • Question
populate data based on Matching headers for multiple sheets across files
Replies
0
Views
106
Amer Omar
A
L
  • Question
VBA to copy data based on column data to multiple files
Replies
9
Views
342
LyonDer
L
G
  • Solved
Find partial text match and then list out the header row for the match
Replies
3
Views
157
Cubist
Cubist
M
  • Question
VBA Subtotal 47,000+ Rows
Replies
1
Views
140
igold
igold
K
  • Question
Return column header name for item located in an array
Replies
4
Views
109
DanteAmor
DanteAmor

Forum statistics

Threads
1,221,443
Messages
6,159,907
Members
451,601
Latest member
terrynelson55

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