Can anyone automate this?

[JumboCactuar]

Best shown with screenshots:

i have data like this (column A and B)

I want everything from column B with same A value like below:

So cell A1 would be "A"
then row 2, first 10 values of column b
row 3 next 10 values until last "A" in column 1

space

"B"
and repeat

any help appreciated

 

[MickG]

Try this for Results on sheet2.

[COLOR="Navy"]Sub[/COLOR] MG15Jan43
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[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, 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
[COLOR="Navy"]Dim[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, R [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Rw = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    Sheets("Sheet2").Cells(Rw, 1) = K
    Rw = Rw + 1: col = 0
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] .Item(K)
        col = col + 1
        Sheets("Sheet2").Cells(Rw, col) = R.Offset(, 1).Value
        [COLOR="Navy"]If[/COLOR] col Mod 10 = 0 [COLOR="Navy"]Then[/COLOR]
            Rw = Rw + 1: col = 0
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] R
Rw = Rw + 2
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[JumboCactuar]

Try this for Results on sheet2.

[COLOR=Navy]Sub[/COLOR] MG15Jan43
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[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, 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
[COLOR=Navy]Dim[/COLOR] Rw [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] K [COLOR=Navy]As[/COLOR] Variant, R [COLOR=Navy]As[/COLOR] Range, c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] col [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
Rw = 1
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
    Sheets("Sheet2").Cells(Rw, 1) = K
    Rw = Rw + 1: col = 0
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] .Item(K)
        col = col + 1
        Sheets("Sheet2").Cells(Rw, col) = R.Offset(, 1).Value
        [COLOR=Navy]If[/COLOR] col Mod 10 = 0 [COLOR=Navy]Then[/COLOR]
            Rw = Rw + 1: col = 0
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] R
Rw = Rw + 2
[COLOR=Navy]Next[/COLOR] K
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

so impressive thank you
works perfect

 

[MickG]

You're welcome