Turning data Horizontal to logical table based

[exllearner]

hello,

I have data like below.

Family_Name | People In the Family
ABC | 1a| 2a|3a|4a|5a
CDE | 1b|2b| 3b|
FGH | 1c|
IJK |1d| 2d| 3d|4d|

Like above I have like 15columns*5000 rows of data but I want to see it like below

ABC
1a
2a
3a
4a
5a
CDE
1b
2b
3b
FGH
1c

...etc or in the smiler format but within two different columns is also fine.
I tried with pivot but it does not look like I get much help when I have uneven columns like this. So, please give me possible solutions.

 

[Matt Allington]

Use power query. Select the first column, then unpivot other columns.

 

[Fluff]

Hi & welcome to the board.
How about

Sub AddRowsTranspose()

   Dim Cnt As Long
   Dim Rws As Long
   
   For Cnt = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Rws = WorksheetFunction.CountA(Rows(Cnt)) - 1
      Range("A" & Cnt + 1).Resize(Rws).EntireRow.Insert
      Range("A" & Cnt + 1).Resize(Rws).Value = Application.Transpose(Range("B" & Cnt).Resize(, Rws).Value)
   Next Cnt
   Range("B:O").Delete
End Sub

As this deletes columns make sure you try it on a copy

 

[exllearner]

I will try and let you know but many many thanks for the help.

 

[exllearner]

Hi FLuff,

This works great but when I have huge data this does not look good and if every family name has ID association like below


ID| Family_Name | People In the Family
ID1| ABC | 1a| 2a|3a|4a|5a


i want to change to the below, c


ID| Family_Name | People In the Family
ID1| ABC | 1a
ID1| ABC | 2a
ID1| ABC | 3a
ID1| ABC | 4a
ID1| ABC | 5a


many thanks in advance.

Hi & welcome to the board.
How about

Sub AddRowsTranspose()

   Dim Cnt As Long
   Dim Rws As Long
   
   For Cnt = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Rws = WorksheetFunction.CountA(Rows(Cnt)) - 1
      Range("A" & Cnt + 1).Resize(Rws).EntireRow.Insert
      Range("A" & Cnt + 1).Resize(Rws).Value = Application.Transpose(Range("B" & Cnt).Resize(, Rws).Value)
   Next Cnt
   Range("B:O").Delete
End Sub

As this deletes columns make sure you try it on a copy

 

[Fluff]

Ok, how about

Sub AddRowsTranspose()

   Dim Cnt As Long
   Dim Rws As Long
   
   For Cnt = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Rws = WorksheetFunction.CountA(Rows(Cnt)) - 3
      Range("A" & Cnt + 1).Resize(Rws).EntireRow.Insert
      Range("A" & Cnt).Resize(Rws + 1, 2).FillDown
      Range("C" & Cnt + 1).Resize(Rws).Value = Application.Transpose(Range("D" & Cnt).Resize(, Rws).Value)
      Range("D:O").Delete
   Next Cnt
End Sub

 

[exllearner]

Ok, how about

Sub AddRowsTranspose()

   Dim Cnt As Long
   Dim Rws As Long
   
   For Cnt = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Rws = WorksheetFunction.CountA(Rows(Cnt)) - 3
      Range("A" & Cnt + 1).Resize(Rws).EntireRow.Insert
      Range("A" & Cnt).Resize(Rws + 1, 2).FillDown
      Range("C" & Cnt + 1).Resize(Rws).Value = Application.Transpose(Range("D" & Cnt).Resize(, Rws).Value)
      Range("D:O").Delete
   Next Cnt
End Sub

This is working fine with one row not for all rows in the whole table that I mentioned in the first post.

 

[Fluff]

Apologies, just realised that this is posted in the Power BI forum, about which I no nothing.
Whilst this should work with a normal xl sheet, or table, I have no idea if it can be made to work for you.