Transpose data in Excel

[missminimac]

Greetings from Colorado,

Working in Excel 2010.
Is there a transpose solution to create the desire table below?

Current table:

code	job	survey ID	match
12345	Accountant	PHRA-GSK12	F395-5
12345	Accountant	PHRA-GSK12	3303
12345	Accountant	PHRA-GSK12	Z010-6

<colgroup><col><col><col><col></colgroup><tbody>
</tbody>

Desire table:

code	job	Survey ID + match 1	Survey ID + match 2	Survey ID + match 3
12345	Accountant	PHRA-GSK12 F395-5	PHRA-GSK12 3303	PHRA-GSK12 Z010-6

<colgroup><col><col><col><col><col></colgroup><tbody>
</tbody>

Thanks so much for your help!

Snowed in co all day yesterday Happy May
missminimac

 

[MickG]

Just thought if you name is a reflection that you are working with a "Mac" then this code will not do !!!!!
I could probably write something else, let me Know !!!

Try this:-
Results start "F1"

[COLOR=navy]Sub[/COLOR] MG02May53
[COLOR=navy]Dim[/COLOR] Rng         [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn          [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] n           [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Q
[COLOR=navy]Dim[/COLOR] Num         [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] oMax        [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 Rng.Count * 3)
[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]
        n = n + 1
        Ray(n, 1) = Dn
        Ray(n, 2) = Dn.Offset(, 1)
        Ray(n, 3) = IIf(n = 1, Dn.Offset(, 2) & " " & Dn.Offset(, 3) & " 1", Dn.Offset(, 2) & " " & Dn.Offset(, 3))
        .Add Dn.Value, Array(n, 3)
    [COLOR=navy]Else[/COLOR]
        Q = .Item(Dn.Value)
            Num = Q(1)
            Q(1) = Q(1) + 1
            Ray(1, Q(1)) = "Survey ID + match " & Num - 1
            Ray(Q(0), Q(1)) = Dn.Offset(, 2) & " " & Dn.Offset(, 3)
            oMax = Application.Max(oMax, Q(1))
        .Item(Dn.Value) = Q
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
Range("F1").Resize(.Count, oMax) = Ray
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[missminimac]

Mick, brilliant solution. Code is rock solid.
You made my day!

Many thanks,
missminimac

Just thought if you name is a reflection that you are working with a "Mac" then this code will not do !!!!!
I could probably write something else, let me Know !!!

Try this:-
Results start "F1"

[COLOR=navy]Sub[/COLOR] MG02May53
[COLOR=navy]Dim[/COLOR] Rng         [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn          [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] n           [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Q
[COLOR=navy]Dim[/COLOR] Num         [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] oMax        [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 Rng.Count * 3)
[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]
        n = n + 1
        Ray(n, 1) = Dn
        Ray(n, 2) = Dn.Offset(, 1)
        Ray(n, 3) = IIf(n = 1, Dn.Offset(, 2) & " " & Dn.Offset(, 3) & " 1", Dn.Offset(, 2) & " " & Dn.Offset(, 3))
        .Add Dn.Value, Array(n, 3)
    [COLOR=navy]Else[/COLOR]
        Q = .Item(Dn.Value)
            Num = Q(1)
            Q(1) = Q(1) + 1
            Ray(1, Q(1)) = "Survey ID + match " & Num - 1
            Ray(Q(0), Q(1)) = Dn.Offset(, 2) & " " & Dn.Offset(, 3)
            oMax = Application.Max(oMax, Q(1))
        .Item(Dn.Value) = Q
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
Range("F1").Resize(.Count, oMax) = Ray
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[MickG]

Your welcome
Regrds Mick