sort and seperate 4 columns of data to seperate lists depending on number in column 1

[AkaTrouble]

Hello

i have an automatically populated list of data spanning 4 columns in width, in first column is list of numbers these can range from just one up to an unknown number (50 is highest i recall)

Example

No ID Name Task
1 1 name task
1 2 name task
1 3 name task
1 4 name task
2 1 name task
2 2 name task
2 3 name task
2 4 name task
2 5 name task


columns are all formatted as text not numbers

there can be varying number of entries for each number (not equal)

what i would like to do is have each set of data for each number in column one copied to the right creating seperate lists

example

No ID Name Task No ID Name Task No ID Name Task
1 1 name task 1 1 name task 2 1 name task
1 2 name task 1 2 name task 2 2 name task
1 3 name task 1 3 name task 2 3 name task
1 4 name task 1 4 name task 2 4 name task
2 1 name task 2 5 name task
2 2 name task
2 3 name task
2 4 name task
2 5 name task

the left hand 4 columns are the original list, it is usually in numerical (formatted as text) order on column one upon being added and each number is always grouped together the list length can be upto 50 unique numbers with 50 rows each but always vary.

currently the headers of list start in A5 across to D5 i would like blank column between each separated set

hope i have explained in enough detail please ask if not

Thanks For Reading

 

[MickG]

Try this:-

[COLOR=navy]Sub[/COLOR] MG05Nov37
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, col [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A6"), Range("A" & Rows.Count).End(xlUp))
col = 6: c = 5
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Dn.Offset(1).Value <> Dn.Value [COLOR=navy]Then[/COLOR]
        c = c + 1
        Cells(5, col).Resize(, 4).Value = Range("A5").Resize(, 4).Value
        Cells(c, col).Resize(, 4).Value = Dn.Resize(, 4).Value
        col = col + 5
        c = 5
    [COLOR=navy]Else[/COLOR]
        c = c + 1
        Cells(5, col).Resize(, 4).Value = Range("A5").Resize(, 4).Value
        Cells(c, col).Resize(, 4).Value = Dn.Resize(, 4).Value
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[AkaTrouble]

Try this:-Regards Mick

EDITED

Great work though Thank You

 

[AkaTrouble]

ok i messed up on my list all fixed

This works Great Thanks

is there a tweek i can make so that it formats all the cells in column 1 and 2 as numbers or text, as presently it only formats first data row of each number as text and others as numbers


Thanks

 

[MickG]

Try:-

[COLOR="Navy"]Sub[/COLOR] MG06Nov47
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A6"), Range("A" & Rows.Count).End(xlUp))
col = 6: c = 5
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Dn.Offset(1).Value <> Dn.Value [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        Cells(5, col).Resize(, 4).Value = Range("A5").Resize(, 4).Value
        Cells(c, col).Resize(, 4).Value = Dn.Resize(, 4).Value
        Cells(c, col).Resize(, 2).NumberFormat = "@" '[COLOR="Green"][B]Text or number, Take your Pick :- "0"[/B][/COLOR]
        col = col + 5
        c = 5
    [COLOR="Navy"]Else[/COLOR]
        c = c + 1
        Cells(5, col).Resize(, 4).Value = Range("A1").Resize(, 4).Value
        Cells(c, col).Resize(, 4).Value = Dn.Resize(, 4).Value
        Cells(c, col).Resize(, 2).NumberFormat = "@" '[COLOR="Green"][B]"0"[/B][/COLOR]
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[AkaTrouble]

Try:- ...... Regards Mick

That works Great Thank You very much and thanks for checking back