VBA to insert rows and transpose columns

[midknight808]

I am processing survey data and am going through a very tedious time with transposing columns into new rows and need the VBA expertise of this group!

My data looks like this (as an example):

ID Are you male or female? What is your favorite color?
1 2 3
2 1 2
3 1 1
4 2 5
5 1 5

I need it to look like this:

ID
1 Are you male or female? 2
1 What is your favorite color? 3
2 Are you male or female? 1
2 What is your favorite color? 2
3 Are you male or female? 1
3 What is your favorite color? 1
4 Are you male or female? 2
4 What is your favorite color? 5
5 Are you male or female? 1
5 What is your favorite color? 5

Any help you can offer is greatly appreciated! TIA!!

 

[MickG]

Try this :-
Your data columns "A,B & C"
results start "F1".

[COLOR="Navy"]Sub[/COLOR] MG27Nov50
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
ReDim ray(1 To (Rng.Count * 2) + 1, 1 To 3)
ray(1, 1) = Cells(1): c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    c = c + 1
    ray(c, 1) = Dn.Value
    ray(c, 2) = Rng(1).Offset(-1, 1)
    ray(c, 3) = Dn.Offset(, 1).Value
    c = c + 1
    ray(c, 1) = Dn.Value
    ray(c, 2) = Rng(1).Offset(-1, 2)
    ray(c, 3) = Dn.Offset(, 2).Value
[COLOR="Navy"]Next[/COLOR] Dn
Range("F1").Resize(c, 3).Value = ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick