Sort data by column question

star212

New Member
Joined
Aug 13, 2010
Messages
2
I was wondering if there is any way to sort data so that it lines up under a specific column and the extra goes in blank columns to the right.

Ex:

Column Heading: 1 2 3 4 5 6 7
Data: 2 5 6 7 7 3 5 4 8

Need to to look like this:

Column Heading: 1 2 3 4 5 6 7
Data 2 3 4 5 6 7 8
5 7

Is there a formula or a macro script that could do this? Thanks
 

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
Hi, Try this:-
NB:- You numbers should be places in row (1), seperate columns with no other Data.

Code:
[COLOR="Navy"]Sub[/COLOR] MG14Aug16
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nRay [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Cells(1, Columns.Count).End(xlToLeft))
ReDim Ray(1 To Rng.Count)

[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                .Add Dn.Value, ""
            [COLOR="Navy"]Else[/COLOR]
                c = c + 1
                Ray(c) = Dn.Value
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR]
            nRay = .keys
            Num = .Count
[COLOR="Navy"]End[/COLOR] With
Rows("1:1").ClearContents
[COLOR="Navy"]With[/COLOR] Range("A100").Resize(Num)
        .Value = Application.Transpose(nRay)
        .Sort Range("A100"), xlAscending
        Range("A2").Resize(, c) = Ray
        Range("A1").Resize(, Num) = Application.Transpose(.Value)
        .ClearContents
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

star212

New Member
Joined
Aug 13, 2010
Messages
2
Thank you so much for your help! I put in the script, only it comes up with a run time error on the

Range("A2").Resize(, c) = Ray

part of the script. Thanks again
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Hi, Try this, the Error was possibly because your row of numbers had no duplicates.
Code:
[COLOR="Navy"]Sub[/COLOR] MG17Aug49
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nRay [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Cells(1, Columns.count).End(xlToLeft))
ReDim Ray(1 To Rng.count)
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                .Add Dn.Value, ""
            [COLOR="Navy"]Else[/COLOR]
                c = c + 1
                Ray(c) = Dn.Value
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR]
            nRay = .keys
            Num = .count
[COLOR="Navy"]End[/COLOR] With
Rows("1:1").ClearContents
[COLOR="Navy"]With[/COLOR] Range("A100").Resize(Num)
        .Value = Application.Transpose(nRay)
        .sort Range("A100"), xlAscending
        [COLOR="Navy"]If[/COLOR] c > 0 [COLOR="Navy"]Then[/COLOR]
        Range("A2").Resize(, c) = Ray
        [COLOR="Navy"]End[/COLOR] If
        Range("A1").Resize(, Num) = Application.Transpose(.Value)
        .ClearContents
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

Watch MrExcel Video

Forum statistics

Threads
1,123,305
Messages
5,600,867
Members
414,410
Latest member
4610

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
Top