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 VariantmyCols = InputBox("Duplicate what columns?" & vbCrLf & "For multiple columns, please separate column letters by a comma.")With Sheets("Result") .UsedRange.Cells.Offset(1, 0).ClearContentsEnd WithEnd Sub
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.
Assign this macro to your "Duplicate Rows" button.
Sub Commas()Dim lngLastRow As LongDim lngRow As LongDim lngCol As LongDim lngSaveRow As LongDim strParts() As StringDim lngPart As LongDim wsM As WorksheetDim wsR As WorksheetSet wsR = ThisWorkbook.Sheets("Result")Set wsM = ThisWorkbook.Sheets("Master")wsR.UsedRange.Cells.Offset(1, 0).ClearContentsApplication.ScreenUpdating = FalseWith 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").DeleteEnd WithApplication.ScreenUpdating = TrueEnd Sub
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.
Open in new window