VBA - Duplicate rows where celles have values seperated by a comma

Hi, everyone

I need you help with a macro I would need to build for an excel file.

In my sheet called “Master”, I have multiple columns that could vary. Could be less or could be more.
The first row would always be the column header names.

Then I can have up to 3000 rows of data +/-.

The objective of the macro is to duplicate rows when a cell from specified columns contain multiple values separated by a comma.
The columns would be identified in a Message Input Box where Column Letters would be separated by a comma as well if more than one as you will see in below picture. So columns to search those values with comma may vary.

To add to the complexity, it I select 3 columns that could contain values with comma, it would duplicate the rows making sure that I have a single sample of each values.

Ex:

 Private Sub DupRows_Click()
Dim myCols As Variant
myCols = InputBox("Duplicate what columns?" & vbCrLf & "For multiple columns, please separate column letters by a comma.")

With Sheets("Result")
        .UsedRange.Cells.Offset(1, 0).ClearContents
End With


End Sub

Open in new window

As you can see in above picture row 2, Column F and M as values separated with Comma. It have 4 different values per cells.
Once the macro runs, it would create 16 identical rows but only put unique values from the strings with comma.

For row 3, in the 3 selected columns, only column C as values separated by comma. It would then duplicate 4 rows but only putting 1 single value per rows.

The result would then be like below:

The data should be pasted to the sheet called: “Result”. It should not change anything in the sheet called “Master”

I also need to say that the number of values separated by a comma can also vary.

How can I do that?
Thank you for your help.

Duplicate rows no1.xlsm

Microsoft OfficeVBAMicrosoft Excel

Last Comment

Martin Liss

8/22/2022 - Mon

Martin Liss

6/4/2021

Assign this macro to your "Duplicate Rows" button.

Sub Commas()
Dim lngLastRow As Long
Dim lngRow As Long
Dim lngCol As Long
Dim lngSaveRow As Long
Dim strParts() As String
Dim lngPart As Long
Dim wsM As Worksheet
Dim wsR As Worksheet

Set wsR = ThisWorkbook.Sheets("Result")
Set wsM = ThisWorkbook.Sheets("Master")

wsR.UsedRange.Cells.Offset(1, 0).ClearContents

Application.ScreenUpdating = False

With wsR
    wsM.UsedRange.Cells.Copy Destination:=wsR.Range("A2")
    lngLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    For lngRow = lngLastRow To 2 Step -1
        For lngCol = 1 To 20
            If InStr(1, .Cells(lngRow, lngCol), ",") > 1 Then
                lngSaveRow = lngRow
                strParts = Split(.Cells(lngRow, lngCol), ",")
                .Cells(lngRow, lngCol) = strParts(0)
                For lngPart = 1 To UBound(strParts)
                    .Rows(lngRow).EntireRow.Insert
                    .Rows(lngRow + 1).Copy Destination:=.Cells(lngRow, "A")
                    .Cells(lngRow, lngCol) = strParts(lngPart)
                Next
                lngRow = lngRow + UBound(strParts)
            End If
        Next
    Next
    .Rows("1:1").Delete
End With

Application.ScreenUpdating = True

End Sub

Open in new window

Wilder1626

6/4/2021

ASKER

Hi Martin
The macro looks very good.
I was wondering if i could decide what columns i want to duplicates.
Ex:
If i have column C, F, G that contains values separated with comma, but i just want to duplicate based on columns C and G. It should then only duplicates C and G columns. F would not be duplicated and remain with multiple values separated with comma.

In another scenario, i could decide to only duplicate column R

That's the reason i was thinking of using a message with an input box. In the Input box, i would identify the selected columns.

ASKER CERTIFIED SOLUTION

Martin Liss

6/4/2021

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.

View this solution by signing up for a free trial.

Members can start a 7-Day free trial and enjoy unlimited access to the platform.

See Pricing Options

Start Free Trial

GET A PERSONALIZED SOLUTION

Ask your own question & get feedback from real experts

Find out why thousands trust the EE community with their toughest problems.

All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat

William Peck