Convert Single Record with multiple values in a cell to multiple records

[geauxin]

I'm trying to convert data from a single record into multiple records for each value (comma delimited within the cell). The values in column B may have up to 20 unique values (never any duplicates).

My Data:

Column A	Column B
John Doe	Door 1, Door 2, Door 3,
Jane Doe	Door 1, Door 4, Door 5

Desired Output:

Column A	Column B
John Doe	Door 1
John Doe	Door 2
John Doe	Door 3
Jane Doe	Door 1
Jane Doe	Door 4
Jane Doe	Door 6

 

[geauxin]

Sorry if I didn't provide enough effort or context, it's been a few years since I've coded a macro.

Currently struggling with creating an array of the values in Column B. I'm thinking now it may be easiest to add values to a completely a new worksheet to avoid loop issues when working through each line.

Current progress below, don't judge my rudimentary coding too harshly please...

Sub FormatDoorAccessList()
    Dim MyCell As Range, MyRange As Range
    Dim AccessVar As Range
    
    Dim strEmpName As String ' Declares variable for each original record's employee name
    Dim StrEmpAccessLvls As String ' Declares variable for each original records assigned access levels
    
    Dim i As Integer 'Declares variable to use for each orignial record
    Dim x As Integer 'Declares variable to use as count of access levels for each original records
    Dim z As Integer 'Declares variable to use as running count for pasting records into new sheet

    
    Set MyRange = Sheets("CurrentAccessList").Range("B3")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    
    Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
        Sheets(Sheets.Count).Name = "NewAccessList" ' renames the new worksheet
        
    Sheets.Name(CurrentAccessList).Activate
        
    
    For Each MyCell In MyRange
        strEmpName = MyCell.Value 'Set variable to Employee Name
        AccessVar = MyCell.Offset(0, 1) 'Defines the access list cell location as a Range
        StrEmpAccessLvls = AccessVar.Value 'Sets the assigned access levels to a string variable
        MyString() = Split(StrEmpAccessLvls, ",") 'Converts the access list string to an Array
        
        
        
End Sub

 

[JoeMo]

The code below uses the layout shown here. The output is written to columns D:E.

Book1
	A	B	C	D	E
1	Name	Door		Name	Door
2	John Doe	Door 1, Door 2, Door 3, Door4, Door5, Door6		John Doe	Door 1
3	Jane Doe	Door 1, Door 4, Door 5		John Doe	Door 2
4				John Doe	Door 3
5				John Doe	Door4
6				John Doe	Door5
7				John Doe	Door6
8				Jane Doe	Door 1
9				Jane Doe	Door 4
10				Jane Doe	Door 5
Sheet8 (2)

Sub geauxin()
Dim Vin As Variant, Vout As Variant, i As Long, S As Variant, ct As Long, k As Long
Vin = Range("A2:B" & Cells(Rows.Count, "B").End(xlUp).Row).Value
ReDim Vout(1 To 20 * UBound(Vin, 1), 1 To 2)
For i = 1 To UBound(Vin, 1)
    S = Split(Vin(i, 2), ", ")
    For k = ct + 1 To ct + UBound(S) + 1
        Vout(k, 1) = Vin(i, 1)
        Vout(k, 2) = S(k - 1 - ct)
    Next k
    ct = ct + UBound(S) + 1
    Erase S
Next i
Range("D:E").ClearContents
Range("D1:E1").Value = Range("A1:B1").Value
Range("D2:E" & UBound(Vout) + 1).Value = Vout
End Sub

 

[geauxin]

The code below uses the layout shown here. The output is written to columns D:E.

Book1
	A	B	C	D	E
1	Name	Door		Name	Door
2	John Doe	Door 1, Door 2, Door 3, Door4, Door5, Door6		John Doe	Door 1
3	Jane Doe	Door 1, Door 4, Door 5		John Doe	Door 2
4				John Doe	Door 3
5				John Doe	Door4
6				John Doe	Door5
7				John Doe	Door6
8				Jane Doe	Door 1
9				Jane Doe	Door 4
10				Jane Doe	Door 5
Sheet8 (2)

Sub geauxin()
Dim Vin As Variant, Vout As Variant, i As Long, S As Variant, ct As Long, k As Long
Vin = Range("A2:B" & Cells(Rows.Count, "B").End(xlUp).Row).Value
ReDim Vout(1 To 20 * UBound(Vin, 1), 1 To 2)
For i = 1 To UBound(Vin, 1)
    S = Split(Vin(i, 2), ", ")
    For k = ct + 1 To ct + UBound(S) + 1
        Vout(k, 1) = Vin(i, 1)
        Vout(k, 2) = S(k - 1 - ct)
    Next k
    ct = ct + UBound(S) + 1
    Erase S
Next i
Range("D:E").ClearContents
Range("D1:E1").Value = Range("A1:B1").Value
Range("D2:E" & UBound(Vout) + 1).Value = Vout
End Sub

You are an amazing human. Thank you so much for your help. Takes me a few weeks to get back in the coding mindset...

 

[JoeMo]

You are an amazing human. Thank you so much for your help. Takes me a few weeks to get back in the coding mindset...

You are welcome - thanks for the reply.