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

geauxin

New Member
Joined
Feb 21, 2023
Messages
3
Office Version
  1. 2021
Platform
  1. Windows
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 AColumn B
John DoeDoor 1, Door 2, Door 3,
Jane DoeDoor 1, Door 4, Door 5

Desired Output:
Column AColumn B
John DoeDoor 1
John DoeDoor 2
John DoeDoor 3
Jane DoeDoor 1
Jane DoeDoor 4
Jane DoeDoor 6
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
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...

VBA Code:
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
 
Upvote 0
The code below uses the layout shown here. The output is written to columns D:E.
Book1
ABCDE
1NameDoorNameDoor
2John DoeDoor 1, Door 2, Door 3, Door4, Door5, Door6John DoeDoor 1
3Jane DoeDoor 1, Door 4, Door 5John DoeDoor 2
4John DoeDoor 3
5John DoeDoor4
6John DoeDoor5
7John DoeDoor6
8Jane DoeDoor 1
9Jane DoeDoor 4
10Jane DoeDoor 5
Sheet8 (2)

VBA Code:
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
 
Upvote 0
The code below uses the layout shown here. The output is written to columns D:E.
Book1
ABCDE
1NameDoorNameDoor
2John DoeDoor 1, Door 2, Door 3, Door4, Door5, Door6John DoeDoor 1
3Jane DoeDoor 1, Door 4, Door 5John DoeDoor 2
4John DoeDoor 3
5John DoeDoor4
6John DoeDoor5
7John DoeDoor6
8Jane DoeDoor 1
9Jane DoeDoor 4
10Jane DoeDoor 5
Sheet8 (2)

VBA Code:
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...
 
Upvote 0

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top