Splitting values from one cell to multiple rows with the same booking information

[excelnewbielearning]

Hello there,


I recently started learning excel and am having some troubles, I was hoping someone could help me.


I can't fully divulge all the field names and information but to give a simple idea what I essentially have is,


A user inputs data into cells on a user form, these cells are then recorded onto another excel sheet via the use of a macro - user clicks 'book' and the booking information is logged in the second sheet. However, my problem is that in the user form the table cell has more than one values separated by commas. I need to record each of those values with the same booking information from the other cells.


Please see below for clarification:


Tab 1 User form -

[TABLE="width: 250"]
<tbody>[TR]
[TD]Booking name:[/TD]
[TD]Booking 1[/TD]
[/TR]
[TR]
[TD]Tables required:[/TD]
[TD]101, 106, 108[/TD]
[/TR]
</tbody>[/TABLE]




I need the information above to appear in the second tab as below -


Tab 2 Booking entries -

[TABLE="width: 250"]
<tbody>[TR]
[TD]Booking 1[/TD]
[TD]101[/TD]
[/TR]
[TR]
[TD]Booking 1[/TD]
[TD]106[/TD]
[/TR]
[TR]
[TD]Booking 1[/TD]
[TD]108[/TD]
[/TR]
</tbody>[/TABLE]



I have tried using a macro and copy and pasting the fields from the user's form onto the booking entries form 3 times and then removing the values on each row. But that only appears to work if I only ever have 3 values in my table required field.

Please help if possible. Thank you.

Best wishes,

 

[pbornemeier]

Option Explicit

Sub SplitEntries()

    Dim wksInput As Worksheet
    Dim wksOutput As Worksheet
    Dim lNextWriteRow As Long
    Dim arySplit As Variant
    Dim lSplitIndex As Long
    Dim sName As String
    
    Set wksInput = Worksheets("Sheet1")
    Set wksOutput = Worksheets("Sheet2")
    
    With wksOutput
        lNextWriteRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    
    sName = wksInput.Range("cellName").Value
    arySplit = Split(wksInput.Range("cellTables").Value, ",")
    
    For lSplitIndex = LBound(arySplit) To UBound(arySplit)
        lNextWriteRow = lNextWriteRow + 1
        wksOutput.Cells(lNextWriteRow, 1).Value = sName
        wksOutput.Cells(lNextWriteRow, 2).Value = Trim(arySplit(lSplitIndex))
    Next
    
    wksInput.Range("cellName").ClearContents
    wksInput.Range("cellTables").ClearContents
    
    Set wksInput = Nothing
    Set wksOutput = Nothing
    
    
End Sub