Complicated table transpose with two columns to multiple columns

[alexllap]

I'm needing some help turning a table with two columns, into a table with multiple columns based on the information in the column. The table I currently have has over 300 rows and I want to turn this:

[TABLE="width: 500"]
<tbody>[TR]
[TD]123888[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]OTHER US[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]KSU[/TD]
[TD]3.92[/TD]
[/TR]
[TR]
[TD]378288[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]CHAMPAGNE-URBANA[/TD]
[TD]3.8[/TD]
[/TR]
[TR]
[TD]999914[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]PORTLAND STATE[/TD]
[TD]3.4[/TD]
[/TR]
[TR]
[TD]DARTMOUTH[/TD]
[TD]3.6[/TD]
[/TR]
[TR]
[TD]NORTHWESTERN[/TD]
[TD]3.8[/TD]
[/TR]
</tbody>[/TABLE]

into this:

[TABLE="width: 500"]
<tbody>[TR]
[TD]123888[/TD]
[TD]OTHER US[/TD]
[TD]4[/TD]
[TD]KSU[/TD]
[TD]3.92[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]378288[/TD]
[TD]CHAMPAGNE-URBANA[/TD]
[TD]3.8[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]999914[/TD]
[TD]PORTLAND STATE[/TD]
[TD]3.4[/TD]
[TD]DARTMOUTH[/TD]
[TD]3.6[/TD]
[TD]NORTHWESTERN[/TD]
[TD]3.8[/TD]
[/TR]
</tbody>[/TABLE]

Is this possible through a formula or a macro? I'm not too savvy with VBA, but am willing to give that a go if it would be easier. The thing that makes this difficult (at least for me) is that some IDs have multiple schools/GPAs.

Any help is greatly appreciated.

 

[MickG]

Try this for results starting "D1"

[COLOR="Navy"]Sub[/COLOR] MG15Dec55
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
ReDim ray(1 To Rng.Count, 1 To 1)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Dn.Offset(, 1).Value = "" And IsNumeric(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        c = c + 1: Ac = 0
    [COLOR="Navy"]End[/COLOR] If
    Ac = Ac + 1
    [COLOR="Navy"]If[/COLOR] UBound(ray, 2) < Ac [COLOR="Navy"]Then[/COLOR] ReDim Preserve ray(1 To Rng.Count, 1 To Ac)
        ray(c, Ac) = Dn.Value
    [COLOR="Navy"]If[/COLOR] Ac > 1 [COLOR="Navy"]Then[/COLOR]
        Ac = Ac + 1
        [COLOR="Navy"]If[/COLOR] UBound(ray, 2) < Ac [COLOR="Navy"]Then[/COLOR] ReDim Preserve ray(1 To Rng.Count, 1 To Ac)
    ray(c, Ac) = Dn.Offset(, 1).Value
    [COLOR="Navy"]End[/COLOR] If
    
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]With[/COLOR] Range("D1").Resize(c, UBound(ray, 2))
    .Value = ray
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[alexllap]

Hi Mick,

I'm getting: "Run-time error '9': Subscript out of range" it looks like at line 13 or 14.

I copied your code into a new blank module in VBA, and tried to run it. Then, I stepped-into it and nothing happens in the table, just the error. Let me know if I'm doing something wrong.

 

[MickG]

Below is an example of your data with Command Button holding the same code for results starting "D1".
Check your data format against this example, call back if necessary !!!
https://app.box.com/s/hcih8x1eic4jw2pvzuon75449gi0xe8p

 

[alexllap]

That worked wonders! Thank you so much! Now if only I knew what was happening!