Sorting and Matching Multiple Columns

[bmpreston]

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

 

[Joe4]

Are your two blocks of data columns A-C and E-G?
Does that actual data start on row 2?

 

[MickG]

Based on your data being in columns "A to G" then try this for results on sheet2, starting "A1.

[COLOR=navy]Sub[/COLOR] MG07Sep13
[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]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]Set[/COLOR] Rng = Union(Rng, Rng.Offset(, 4))
[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(UBound(Ray, 1) + 2, 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

 

[bmpreston]

I can or cannot have headers. It's loose. So I can add the top row.

It is true I am A, B, C and E, F, G, but I can move them wherever.

Once I get them lined up, I need to do some basic conditional formatting, but I need to get the data to comparison sake first.

Thanks

 

[MickG]

If you replace the last bit of code with the below, it will overwrite your data in the Active sheet.

With ActiveSheet.Range("A1").Resize(UBound(Ray, 1) + 2, 7)
    .ClearContents
    .Value = nRay
    .Borders.Weight = 2
    .Columns.AutoFit
End With

 

[bmpreston]

So I had a chance to play with response 3 from MickG, it does move the data to sheet2, however it seemingly only gives approx 1400 responses, and then columns (EDIT! EFG, CONFIRMED DATA IS ABC, D BLANK, EFG) fail to come over any more.

It seems almost flawless but I'm missing a big chunk of data.

Thanks!

I will try MickG's answer just prior to my answer here, in a few.

 

[MickG]

Try changing the last bit of code to below:-

With Sheets("Sheet2").Range("A1").Resize(c, 7)
    .Value = nRay
    .Borders.Weight = 2
    .Columns.AutoFit
End With

 

[bmpreston]

So I am posting this so you can see. When I run it, still the same thing. I can't read your code, I just know how to insert and click run, but for some reason, after row 1412 or so, it still seemingly stops this merge. It works great, except....

http://bmpreston.com/Example.xlsm

Thanks for any help!

 

[MickG]

Can you send your file through "Box.com" or "DropBox.com", I'm afraid you file has been rejected by my computer security!!!!

 

[bmpreston]

https://www.dropbox.com/sh/r8j3oh2j7cponlo/AABCW1BV8IT-37vMy1HIsZ4Wa?dl=0

Sorry about that.