Another transposition query

[Malcolm Gill]

hiker95 sorted one query for me. Can anybody out there help with this one?

I have an Excel file of some 1600 rows. Here are the first few rows of 6 columns with headers from the start of the file.

gkey	group_name	forename	surname	added	waiting	leader
3811	B1 Chicago Bridge	Laurie	Adamson	23/10/2016
3793	B4 Chicago Bridge	Laurie	Adamson	23/10/2016
3792	B6 Chicago Bridge	Laurie	Adamson	23/10/2016
3784	A1 Art Workshop 1	Edel	Aguero	03/11/2016
3818	A5 Watercolours	Edel	Aguero	03/11/2016
3815	K6 Keep Fit	Edel	Aguero	03/11/2016
3811	B1 Chicago Bridge	Sylvia	Allen	23/10/2016
3793	B4 Chicago Bridge	Sylvia	Allen	23/10/2016
3805	BA2 Improvers B	Rosemary	Allen	23/10/2016	1
3856	BA3 Duplicate Imp	Rosemary	Allen	23/10/2016
3807	K3 Line Dancing	Rosemary	Allen	23/10/2016
3811	B1 Chicago Bridge	Greg	Ansell	13/10/2016		1
3811	B1 Chicago Bridge	Tiggy	Ansell	23/10/2016
3796	B3 Duplicate Bridge	Greg	Ansell	23/10/2016
3796	B3 Duplicate Bridge	Tiggy	Ansell	23/10/2016
3855	A7 Ten Paintings	Pam	Applin	23/10/2016
3834	J1 Dorset	Pam	Applin	23/10/2016
3847	N2 Wildlife Britain	Pam	Applin	23/10/2016
3866	W7 The Silk Roads	Pam	Applin	29/11/2016
3853	K13 Latin Dancing	Ann	Arthur-Ling	23/10/2016
3807	K3 Line Dancing	Ann	Arthur-Ling	23/10/2016
3862	L11 Beginners G	Ann	Arthur-Ling	23/10/2016	1
3790	BA1 Beginners	Ken	Ashman	23/10/2016
3834	J1 Dorset	Ken	Ashman	23/10/2016
3851	T7 Explore Maths	Ken	Ashman	28/11/2016
3823	W6 Film Studies	Ken	Ashman	23/10/2016
3825	Z1 3 MILE WALKS	Ken	Ashman	23/10/2016
3826	Z2 5 MILE PUB WALKS	Ken	Ashman	23/10/2016
3843	H9 Military History	David	Ashover	23/10/2016

<tbody>
</tbody>

What I would like is

forename	surname	gkey1	gkey2	gkey3	etc
Laurie	Adamson	3811	3793	3792
Edel	Aguero	3784	3818	3815
Sylvia	Allen	3811	3793
Rosemary	Allen	3805	3856	3807
Greg	Ansell	3811	3796
Tiggy	Ansell	3811	3796
Pam	Applin	3855	3834	3847	3866
Ann	Arthur-Ling	3853	3807	3862
Ken	Ashman	3790	3834	3851	3823
David	Ashover	3843

<tbody>
</tbody>

There can be more than one occurrence of surname but with different forename. Each person may have up to 10 gkeys.

I'd be truly grateful for assistance!

 

[MickG]

Try this for results on sheet2.

[COLOR="Navy"]Sub[/COLOR] MG08Dec17
[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] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("C1"), Range("C" & Rows.Count).End(xlUp))
ReDim Ray(1 To Rng.Count, 1 To 3)
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Txt = Dn.Text & Dn.Offset(, 1).Text
        [COLOR="Navy"]If[/COLOR] Not .Exists(Txt) [COLOR="Navy"]Then[/COLOR]
            n = n + 1
            Ray(n, 1) = Dn.Text: Ray(n, 2) = Dn.Offset(, 1).Text
            Ray(n, 3) = Dn.Offset(, -2).Value
            .Add Txt, Array(n, 3)
        [COLOR="Navy"]Else[/COLOR]
            Q = .Item(Txt)
            Q(1) = Q(1) + 1
            [COLOR="Navy"]If[/COLOR] UBound(Ray, 2) < Q(1) [COLOR="Navy"]Then[/COLOR] ReDim Preserve Ray(1 To Rng.Count, 1 To Q(1))
            Ray(Q(0), Q(1)) = Dn.Offset(, -2).Value
            Ray(1, Q(1)) = "gkey" & Q(1) - 2
            .Item(Txt) = Q
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Rw = .Count
Ray(1, 3) = "gkey1"
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(Rw, UBound(Ray, 2))
    .Value = Ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Malcolm Gill]

You guys are just phenomenal!! Thank you so much for your help Mick.

 

[MickG]

You're welcome