Transpose Grouped Data

BoyMom826

New Member
Joined
Dec 11, 2020
Messages
15
Office Version
  1. 365
Platform
  1. Windows
I have be given the below data set. We have 67 rows with four sets of golfer information in each row. I am needing to make it so I only have one golfer/row. I don't know why I'm having so much trouble figuring this out, but I think i've been staring at it too long to have a logical approach. Any assistance would be wonderful!

COMPANYGOLFER 1GOLFER 1 CELL PHONEGOLFER 1 EMAILGOLFER 2GOLFER 2 CELL PHONEGOLFER 2 EMAILGOLFER 3GOLFER 3 CELL PHONEGOLFER 3 EMAILGOLFER 4GOLFER 4 CELL PHONEGOLFER 4 EMAIL
 
It is not clear to me how your data is and what the result will be like.
You could use XL2BB tool minisheets, to put the how it is and the how it should be.
 
Upvote 0
@DanteAmor I apologize for missing this before!!

Here is currently how it is listed. The problem is that I need each individual golfer's information in an uploadable format.
2021 EMGC Golfer Info.xlsx
ABCDEFGHIJKLM
1COMPANYGOLFER 1GOLFER 1 CELL PHONEGOLFER 1 EMAILGOLFER 2GOLFER 2 CELL PHONEGOLFER 2 EMAILGOLFER 3GOLFER 3 CELL PHONEGOLFER 3 EMAILGOLFER 4GOLFER 4 CELL PHONEGOLFER 4 EMAIL
2Company 1 Company 1's 1st GolferCompany 1's 2nd GolferCompany 1's 3rd GolferCompany 1's 4th Golfer
3Company 2 Company 2's 1st GolferCompany 2's 2nd GolferCompany 2's 3rd GolferCompany 2's 4th Golfer
4Company 3 Company 3's 1st GolferCompany 3's 2nd GolferCompany 3's 3rd GolferCompany 3s' 4th Golfer
Sheet2


So instead of Company 1's name with all four golfers listed in the following columns, I would prefer 4 rows of Company 1 each with 1 golfer's name, phone, and email address. Like this:
2021 EMGC Golfer Info.xlsx
ABCD
1COMPANYGOLFER 1GOLFER 1 CELL PHONEGOLFER 1 EMAIL
2Company 1Company 1's 1st Golfer
3Company 1 Company 1's 2nd Golfer
4Company 1Company 1's 3rd Golfer
5Company 1Company 1's 4th Golfer
6Company 2Company 2's 1st Golfer
7Company 2 Company 2's 2nd Golfer
8Company 2Company 2's 3rd Golfer
9Company 2Company 2's 4th Golfer
Sheet3
 
Upvote 0
How about
VBA Code:
Sub BoyMom()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   With Sheets("Sheet2")
      Ary = .Range("A2:M" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary) * 4, 1 To 4)
   
   For r = 1 To UBound(Ary)
      For c = 2 To UBound(Ary, 2) Step 3
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 1)
         Nary(nr, 2) = Ary(r, c)
         Nary(nr, 3) = Ary(r, c + 1)
         Nary(nr, 4) = Ary(r, c + 2)
      Next c
   Next r
   With Sheets("Sheet3")
      Sheets("Sheet2").Range("A1:D1").Copy .Range("A1")
      .Range("A2").Resize(nr, 4).Value = Nary
   End With
End Sub
 
Upvote 0
Solution
An alternative solution is to use Power Query to Unpivot your data

Power Query:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"COMPANY", type text}, {"GOLFER 1", type text}, {"GOLFER 1 CELL PHONE", type any}, {"GOLFER 1 EMAIL", type any}, {"GOLFER 2", type text}, {"GOLFER 2 CELL PHONE", type any}, {"GOLFER 2 EMAIL", type any}, {"GOLFER 3", type text}, {"GOLFER 3 CELL PHONE", type any}, {"GOLFER 3 EMAIL", type any}, {"GOLFER 4", type text}, {"GOLFER 4 CELL PHONE", type any}, {"GOLFER 4 EMAIL", type any}}),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"COMPANY"}, "Attribute", "Value")
in
    #"Unpivoted Other Columns"
 
Upvote 0
How about
VBA Code:
Sub BoyMom()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
  
   With Sheets("Sheet2")
      Ary = .Range("A2:M" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary) * 4, 1 To 4)
  
   For r = 1 To UBound(Ary)
      For c = 2 To UBound(Ary, 2) Step 3
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 1)
         Nary(nr, 2) = Ary(r, c)
         Nary(nr, 3) = Ary(r, c + 1)
         Nary(nr, 4) = Ary(r, c + 2)
      Next c
   Next r
   With Sheets("Sheet3")
      Sheets("Sheet2").Range("A1:D1").Copy .Range("A1")
      .Range("A2").Resize(nr, 4).Value = Nary
   End With
End Sub
Thanks so much! This worked PERFECTLY!
 
Upvote 0
Glad we could help & thanks for the feedback.
 
Upvote 0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top