Hello Forum,
I am very new to VBA and I'm struggling with how to make a modification to a macro I inherited. The goal of the macro is to separate the contents of a cell in column M that has multiple values separated by a comma. In the event that there are multiple values, the macro then needs to copy that row and insert (x) number of rows underneath for each value in column M. I've included the actual code and an attachment below.
MACRO PROBLEMS
1) Sometimes a customer will not have a number and a column M cell will be blank. When I test this scenario, the rows above the blank cell expand but the rows underneath the blank cell do not expand and it fails.
2) I need to populate columns N thru AS with more customer data. I've tried changing several pieces within the macro but again, I'm just starting to learn VBA and I can't figure out what needs to change to include more data to the right of column M.
CURRENT FORM
Column A .... .... Column M Name Number Customer_Name_1 1111111111,2222222222,33333333333,4444444444,5555555555,6666666666,77777777 7777,88888888888 Customer_Name_2 Customer_Name_3 999999999,333333333
DESIRED FORM
Column A .... .... Column M Name Number Customer_Name_1 1111111111 2222222222 33333333333 4444444444 5555555555 6666666666 777777777777 Customer_Name_2 Customer_Name_3 999999999 Customer_Name_3 333333333
expand-cust-data1.xlsm
Sub expandData() Dim custCount As Long, i As Long, j As Integer, splitCount As Integer Dim custNumbers As Variant Dim customer As Range, custValues As Variant custCount = Range(Range("M1"), Range("M1").End(xlDown)).Rows.Count - 1 Set customer = Range("m1") For i = 1 To custCount Set customer = customer.Offset(splitCount + 1) custNumbers = Split(customer.Value, ",") splitCount = UBound(custNumbers) - LBound(custNumbers) custValues = Range(customer.Offset(, -12), customer.Offset(, -1)).Value customer.Value = custNumbers(splitCount) For j = LBound(custNumbers) To splitCount - 1 customer.Offset(1).EntireRow.Insert Range(customer.Offset(1, -12), customer.Offset(1, -1)).Value = custValues customer.Offset(1).Value = custNumbers(j) Next j Next i End Sub Sub reset() Range("a1").CurrentRegion.Clear Range("rawdata").Copy Range("a1") End Sub
I would greatly appreciate anyone's assistance with this. Thank you very much in advance for your help.
~ rm_527