Unpivoting columns in Excel

[vinmam123VBA]

Hi All,

Can you please help me on how to unpivot columns in excel? I am aware of power query method however I need VBA code to do the things for me

Below is the requirements:

In raw data we get leave details like below:

Employee Name	Leave Date
Colleague 1	29/10/2020,30/10/2020
Colleague 2	21/12/2020,22/12/2020,23/12/2020,24/12/2020

We need to change it to below:

Employee Name	Leave Date
Colleague 1	29/10/2020
Colleague 1	30/10/2020
Colleague 2	21/12/2020
Colleague 2	22/12/2020
Colleague 2	23/12/2020
Colleague 2	24/12/2020

Regards,
Vinayak

 

[maabadi]

This Macro Unpivot Column A:B from A2:B2 to Last to Column F:G.

Sub UnpivotData()
Dim i As Long
Dim j As Long
Dim k As Long
Dim Lr As Long
Dim Lr2 As Long
Dim cell As Range
Dim MyRange As Range

Lr = Cells(Rows.Count, 1).End(xlUp).Row
Set MyRange = Range("B2:B" & Lr)
For Each cell In MyRange
k = Len(cell) - Len(Replace(cell, ",", ""))
For j = 0 To k
Lr2 = Cells(Rows.Count, 6).End(xlUp).Row
Range("F" & Lr2 + WorksheetFunction.CountA("B2:B" & cell.Row)) = cell.Offset(0, -1)
Range("G" & Lr2 + WorksheetFunction.CountA("B2:B" & cell.Row)) = Mid(cell, 1 + 11 * j, 10)
Debug.Print Lr2 + WorksheetFunction.CountA("B2:B" & cell.Row)
Next j
Next cell
End Sub

 

[vinmam123VBA]

This Macro Unpivot Column A:B from A2:B2 to Last to Column F:G.

Sub UnpivotData()
Dim i As Long
Dim j As Long
Dim k As Long
Dim Lr As Long
Dim Lr2 As Long
Dim cell As Range
Dim MyRange As Range

Lr = Cells(Rows.Count, 1).End(xlUp).Row
Set MyRange = Range("B2:B" & Lr)
For Each cell In MyRange
k = Len(cell) - Len(Replace(cell, ",", ""))
For j = 0 To k
Lr2 = Cells(Rows.Count, 6).End(xlUp).Row
Range("F" & Lr2 + WorksheetFunction.CountA("B2:B" & cell.Row)) = cell.Offset(0, -1)
Range("G" & Lr2 + WorksheetFunction.CountA("B2:B" & cell.Row)) = Mid(cell, 1 + 11 * j, 10)
Debug.Print Lr2 + WorksheetFunction.CountA("B2:B" & cell.Row)
Next j
Next cell
End Sub

Thank you Maabadi for the help!!

 

[maabadi]

You 're welcome & thanks for feedback.