VBA Macro to insert rows when the following condition is met

[ericcarl]

Hello Forum,
I'm trying to write a conditional macro where VBA will add (x) number of rows depending on how many separate numbers appear in a specific cell. However, I just discovered VBA and I can't find any postings that specifically address this scenario. I don't know if it can be done with a formula - I figured only VBA could add rows dynamically. I've included a generic and fictional example below of how the data appears and how it needs to look like. I am using Excel 2010.

Important Note: Ideally, all of the customer data that appears in columns A - L and N - onward should all replicate on the rows that are created beneath the first row. Also, all of the account number values will be delimited by a comma that separates them and some of them will vary slightly in length.

CURRENT FORM:

Column A	....	....	Column M
Customer_Name			Account_Number
Customer 1			1111111111,2222222222,333333333,44444444444,5555555555,6666666666,7777777777

<tbody>
</tbody>

DESIRED FORM:

Column A	....	....	Column M
Customer_Name			Account_Number
Customer 1			1111111111
Customer 1			2222222222
Customer 1			333333333
Customer 1			44444444444
Customer 1			5555555555
Customer 1			6666666666
Customer 1			7777777777

<tbody>
</tbody>

I have no idea if this can be done but I would be eternally grateful if so

Thank you in advance for your help!
~Eric

 

[CalcSux78]

Eric,

You could use the SPLIT function to split the value in column M into an array then insert required rows below that row. Let me know if I lose you on this.

Sub FlexIt()
Dim R&  [COLOR=#008000]'as long[/COLOR]
Dim n&
Dim lRow&          [COLOR=#008000]   'last row#[/COLOR]
Dim Arr As Variant  [COLOR=#008000]'Array[/COLOR]
Dim sCust$          [COLOR=#008000]'as string[/COLOR]


lRow = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
[COLOR=#008000]'loop backwards since inserting rows[/COLOR]
For R = lRow To 2 Step -1
    sCust = Cells(R, 1)
    Arr = Split(Cells(R, 13), ",")     [COLOR=#008000] 'split column M into array[/COLOR]
    Cells(R, 13) = Arr(0)
    For n = 1 To UBound(Arr)
        Rows(R + n).Insert xlDown
        Cells(R + n, 1) = sCust
        Cells(R + n, 13) = Arr(n)
    Next n
Next R
Application.ScreenUpdating = True
End Sub

 

[ericcarl]

CalcSux78,
Sorry for my delayed response - thank you very much for your help. That was very helpful.

Happy Holidays!
ericcarl