How to split a row into multiple rows based on number of certain columns with data

Question

I have a spreadsheet with booking data. I want to split a row into multiple rows based on how many columns with heading "Book Time" string contains data.

Here's an example

 ID |  SlotNo. | Delivery Date  | Booking No. | Book Time 1 | Truck Sz 1 | Book Time 2 | Truck Sz 2
 1      10415      12/31/2019      10001          00:00         B'Double     00:20         Single

Output

ID |  SlotNo. | Delivery Date  | Booking No. | Book Time | Truck Size |
1      10415     12/31/2019       10001         00:00      B'Double
1      10415     12/31/2019       10001         00:20      Single

I have tried using the solution here Similar solution , but it seems the problem is not so similar.

I'll like to get help on split the row based on how "Book Time" Columns has data in it. There are actually up to 30 "Book Time" Columns.

You will need to use Macro to make this dynamic (considering case **Book Time n**). Hint: go from bottom up and use insert row. — PatricK, Nov 26 '19 at 01:18
As far as I know, stackoverflow isn't a free write it for you site, it's help you troubleshoot your code. — PatricK, Nov 26 '19 at 01:28

score 0 · Accepted Answer · answered Nov 26 '19 at 01:23

Dim shtIn As Worksheet, shtOut As Worksheet
Dim c As Range, c2 As Range

Set shtIn = ThisWorkbook.Sheets("Input")
Set shtOut = ThisWorkbook.Sheets("Output")

Set c = shtIn.Range("A2") 'start of your data
'do while "ID" not empty
Do While Len(c.Value) > 0
    Set c2 = c.EntireRow.Cells(1, "E") 'first "book time" for this row
    'do while "book time" not empty
    Do While Len(c2.Value) > 0
        With shtOut.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            c.Resize(1, 4).Copy .Cells(1)
            c2.Resize(1, 2).Copy .Cells(1).Offset(0, 4)
        End With
        Set c2 = c2.Offset(0, 2) 'next book time
    Loop
    Set c = c.Offset(1, 0)
Loop

How to split a row into multiple rows based on number of certain columns with data

1 Answers1

Linked