VBA/Macro Sort

J

Justijb

New Member
Joined
Aug 16, 2016
Messages
43
Good Day,

I've had luck in the past so I'll try again and a big thanks to everyone who's helped me before.

So, I have worksheet 1 that has data in columns A through M and worksheet 2 with data in columns A through F.

I need to be able to match the data by number in worksheet 1 & 2 on column C. The kicker is I need to be able to insert worksheet 2 data into worksheet 1 and shift all data down for that match by rows. And for every match after that. Example:

Worksheet 1

[TABLE="width: 904"]
<colgroup><col><col><col><col span="10"></colgroup><tbody>[TR]
[TD]a[/TD]
[TD]b[/TD]
[TD]c[/TD]
[TD]d[/TD]
[TD]e[/TD]
[TD]f[/TD]
[TD]g[/TD]
[TD]h[/TD]
[TD]i[/TD]
[TD]j[/TD]
[TD]k[/TD]
[TD]l[/TD]
[TD]m[/TD]
[/TR]
[TR]
[TD]xx[/TD]
[TD]xxx[/TD]
[TD]1234[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[/TR]
</tbody>[/TABLE]

Worksheet 2

[TABLE="width: 456"]
<colgroup><col><col><col><col span="3"></colgroup><tbody>[TR]
[TD]a[/TD]
[TD]b[/TD]
[TD]c[/TD]
[TD]d[/TD]
[TD]e[/TD]
[TD]f[/TD]
[/TR]
[TR]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]1234[/TD]
[TD]yyy[/TD]
[TD]xxxx[/TD]
[TD]x[/TD]
[/TR]
[TR]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]1234[/TD]
[TD]yyy[/TD]
[TD]xxxx[/TD]
[TD]x[/TD]
[/TR]
[TR]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]1234[/TD]
[TD]www[/TD]
[TD]xxxx[/TD]
[TD]x[/TD]
[/TR]
</tbody>[/TABLE]

Desired Output

[TABLE="width: 904"]
<colgroup><col><col><col><col span="10"></colgroup><tbody>[TR]
[TD]a[/TD]
[TD]b[/TD]
[TD]c[/TD]
[TD]d[/TD]
[TD]e[/TD]
[TD]f[/TD]
[TD]g[/TD]
[TD]h[/TD]
[TD]i[/TD]
[TD]j[/TD]
[TD]k[/TD]
[TD]l[/TD]
[TD]m[/TD]
[/TR]
[TR]
[TD]xx[/TD]
[TD]xxx[/TD]
[TD]1234[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[/TR]
[TR]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]1234[/TD]
[TD]yyy[/TD]
[TD]xxxx[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]1234[/TD]
[TD]yyy[/TD]
[TD]xxxx[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]1234[/TD]
[TD]www[/TD]
[TD]xxxx[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 904"]
<colgroup><col><col><col><col span="10"></colgroup><tbody>[TR]
[TD]xx[/TD]
[TD]xxx[/TD]
[TD]5678[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]xx[/TD]
[/TR]
[TR]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]5678[/TD]
[TD]yyy[/TD]
[TD]xxxx[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]5678[/TD]
[TD]yyy[/TD]
[TD]xxxx[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]xx[/TD]
[TD]xx[/TD]
[TD]5678[/TD]
[TD]www[/TD]
[TD]xxxx[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Hopefully this makes sense...Each match may or may not have the same amount of rows associated with it but I just want to view the data "on top of each other" for quick reference. Also, not sure if it will affect the script but there isn't a 1 to 1 match, meaning some data in column C for both worksheets may have no matches.

If i need to explain further, please let me know and thanks again.
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
Re: A Whopper of A Request - VBA/Macro Sort

may be a few real type examples, lots of xxxx there, makes sense to you but not easy to consider
 
Upvote 0
Re: A Whopper of A Request - VBA/Macro Sort

Thanks for the reply. And I get it, i just figured it would be easier to focus on the column/data that it needs to be sorted on. In this example Column ID1 is the sort where we're looking for matches in both worksheet 1 and 2. The output needs to find that match in Column ID1 in both worksheets and then insert Worksheet's 2 data into the row beneath the match.

Worksheet 1
[TABLE="width: 1148"]
<tbody>[TR]
[TD]Number[/TD]
[TD]Name[/TD]
[TD]ID1[/TD]
[TD]Number[/TD]
[TD]Date[/TD]
[TD]Date[/TD]
[TD]Number[/TD]
[TD]ID[/TD]
[TD]Number[/TD]
[TD]Letter Number[/TD]
[TD]Name[/TD]
[TD]Name[/TD]
[TD]ID[/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]John Smith[/TD]
[TD]123456[/TD]
[TD]654321[/TD]
[TD]1/1/2001[/TD]
[TD]1/2/2001[/TD]
[TD]1,234[/TD]
[TD]A123[/TD]
[TD]1000[/TD]
[TD]A1[/TD]
[TD]Omega[/TD]
[TD]Letters[/TD]
[TD]123[/TD]
[/TR]
</tbody>[/TABLE]

Worksheet 2
[TABLE="width: 520"]
<colgroup><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]Date[/TD]
[TD]Number[/TD]
[TD]ID1[/TD]
[TD]Name[/TD]
[TD]Date[/TD]
[TD]Name[/TD]
[/TR]
[TR]
[TD]1/5/2004[/TD]
[TD]23431[/TD]
[TD]123456[/TD]
[TD]Letters[/TD]
[TD]1/10/2002[/TD]
[TD]Letters[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Re: A Whopper of A Request - VBA/Macro Sort

Data in sheets 1 and 2, Results in sheet 3
NB:- Matching columns in both sheets, in column 3.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG29Nov55
[COLOR="Navy"]Dim[/COLOR] Ray1 [COLOR="Navy"]As[/COLOR] Variant, Ray2 [COLOR="Navy"]As[/COLOR] Variant, Ray3 [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray1 = Sheets("Sheet1").Range("A1").CurrentRegion
Ray2 = Sheets("Sheet2").Range("A1").CurrentRegion

Ray = Array(Ray1, Ray2)
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare

[COLOR="Navy"]For[/COLOR] nn = 0 To 1

[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray(nn))
    [COLOR="Navy"]If[/COLOR] Not .Exists(Ray(nn)(n, 3)) [COLOR="Navy"]Then[/COLOR]
        
        ReDim Ray3(1 To UBound(Ray1, 1) + UBound(Ray2, 1), 1 To UBound(Ray1, 2))
        [COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(Ray(nn), 2)
            Ray3(1, Ac) = Ray(nn)(n, Ac)
          [COLOR="Navy"]Next[/COLOR] Ac
            .Add Ray(nn)(n, 3), Array(Ray3, 1)
        [COLOR="Navy"]Else[/COLOR]
          Q = .Item(Ray(nn)(n, 3))
             Q(1) = Q(1) + 1
              [COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(Ray(nn), 2)
                 Q(0)(Q(1), Ac) = Ray(nn)(n, Ac)
             [COLOR="Navy"]Next[/COLOR] Ac
        .Item(Ray(nn)(n, 3)) = Q
    [COLOR="Navy"]End[/COLOR] If
  [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] nn
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant

c = 2

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
   Sheets("Sheet3").Cells(c, 1).Resize(UBound(.Item(K)(0), 1), UBound(.Item(K)(0), 2)) = .Item(K)(0)
   c = c + .Item(K)(1)
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Re: A Whopper of A Request - VBA/Macro Sort

Thanks Mick! Appreciate you taking the time to write this and I'm excited but unfortunately I'm getting a Run-time error '7': Out of Memory. Any thoughts as to why ?
 
Upvote 0
Re: A Whopper of A Request - VBA/Macro Sort

How many rows and columns have you in your data (both sheets)??
Do you know what line it failed on ??
 
Last edited:
Upvote 0
Re: A Whopper of A Request - VBA/Macro Sort

Try this alternative code, Results sheet 3.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG30Nov16
[COLOR="Navy"]Dim[/COLOR] Rng1 [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Rng2 [COLOR="Navy"]As[/COLOR] Range, R1 [COLOR="Navy"]As[/COLOR] Range, R2 [COLOR="Navy"]As[/COLOR] Range, K [COLOR="Navy"]As[/COLOR] Variant, R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, Q [COLOR="Navy"]As[/COLOR] Variant, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Lst1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Lst2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Lt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng1 = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    Lst1 = .Cells("1", Columns.Count).End(xlToLeft).Column
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng2 = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    Lst2 = .Cells("1", Columns.Count).End(xlToLeft).Column
[COLOR="Navy"]End[/COLOR] With

Ray = Array(Rng1, Rng2)
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare

[COLOR="Navy"]For[/COLOR] n = 0 To 1
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Ray(n)
        [COLOR="Navy"]If[/COLOR] Not .exists(Dn.Offset(, 2).Value) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] n = 0 [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] R1 = Dn
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] R2 = Dn
            [COLOR="Navy"]End[/COLOR] If
            .Add Dn.Offset(, 2).Value, Array(R1, R2)
        [COLOR="Navy"]Else[/COLOR]
           Q = .Item(Dn.Offset(, 2).Value)
           [COLOR="Navy"]If[/COLOR] n = 0 [COLOR="Navy"]Then[/COLOR]
              [COLOR="Navy"]If[/COLOR] Q(0) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] Q(0) = Dn Else [COLOR="Navy"]Set[/COLOR] Q(0) = Union(Q(0), Dn)
                
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]If[/COLOR] Q(1) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] Q(1) = Dn Else [COLOR="Navy"]Set[/COLOR] Q(1) = Union(Q(1), Dn)
            [COLOR="Navy"]End[/COLOR] If
          .Item(Dn.Offset(, 2).Value) = Q
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] n
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    [COLOR="Navy"]For[/COLOR] Ac = 0 To 1
        Lt = IIf(Ac = 0, Lst1, Lst2)
        [COLOR="Navy"]If[/COLOR] Not .Item(K)(Ac) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] .Item(K)(Ac)
                c = c + 1
                Sheets("Sheet3").Cells(c, 1).Resize(, Lt).Value = R.Resize(, Lt).Value
            [COLOR="Navy"]Next[/COLOR] R
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
I need help with this code to modify the data into a table using Userform for VBA Excel (I want to do the range unlimited instead to do C7:C80000
Replies
5
Views
641
Dan_W
D
F
  • Question Question
Changing date format based on fiscal years versus calendar years
Replies
2
Views
164
Peter_SSs
Peter_SSs
W
  • Question Question
IF Logic HELP
Replies
7
Views
281
SanjayGMusafir
SanjayGMusafir
J
  • Question Question
VBA Script to Update Files in a folder, updating Links
Replies
1
Views
499
Micron
M
B
  • Question Question
countifs and remove data completed
2
Replies
10
Views
878
MuchToLearn
M

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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