Sort data by column question

[star212]

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

 

[MickG]

Hi, Try this:-
NB:- You numbers should be places in row (1), seperate columns with no other Data.

[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]

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]

Hi, Try this, the Error was possibly because your row of numbers had no duplicates.

[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