VBA - Add X amount of Rows Based On Value of Cell

M

moss84

New Member
Joined
Jan 8, 2016
Messages
5
Hello All - This is my first time posting so please let me know if I am in the right spot.

I am looking for some vba code that will add X amount of rows based on the value of one of my cells. Unfortunately when a deliverable is being released in multiple states my source data dumps all of this information into a single cell (e.g. State (AZ, AK, NM). Basically, I want to write a macro that will generate a new row for each state. All other attributes for the data are identical for each state. Please see below for my current data structure and my desired output. Thanks for the help!

Current Data Structure
Deliverable Date State
Release Pilot 2/1/2015 AZ, NM, WI
Code Freeze 2/1/2015 WI, MI

Desired Output
Deliverable Date State
Release Pilot 2/1/2015 AZ
Release Pilot 2/1/2015 NM
Release Pilot 2/1/2015 WI
Code Freeze 2/1/2015 WI
Code Freeze 2/1/2015 MI
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
Assuming you data is in 3 columns then try this:-
NB:- This code will alter those 3 columns
Code: 
[COLOR="Navy"]Sub[/COLOR] MG08Jan34
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Sp [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray(), c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
ReDim Ray(1 To 3, 1 To 1)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Sp = Split(Dn.Offset(, 2).Value, ", ")
        ReDim Preserve Ray(1 To 3, 1 To UBound(Ray, 2) + UBound(Sp) + 1)
            [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
                c = c + 1
                Ray(1, c) = Dn.Value
                Ray(2, c) = CDbl(DateValue(Dn.Offset(, 1).Value))
                Ray(3, c) = Sp(n)
            [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Dn
Range("A2").Resize(c, 3).Value = Application.Transpose(Ray)
Range("B2").Resize(c).NumberFormat = "0"
Range("B2").Resize(c).NumberFormat = "dd/mm/yyy"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Something like this should work

Code: 
Sub test_stuff()
Dim s_Hold, sRight, sLeft, splitter() As String
Dim i As Integer

s_Hold = Cells(MyRow, MyColumn)
i = InStr(sm, ",")
sRight = Right(sm, Len(sm) - InStrRev(sm, " ", i))
sLeft = Left(sm, InStrRev(sm, " ", i))
splitter = Split(sRight, ",")

For ictr = 0 To UBound(splitter)
     Sheets("MySheet").Cells(ictr + 1, MyColumn) = sLeft & splitter(ictr)
Next ictr

End Sub
 
Last edited:
Upvote 0
[TABLE="width: 1040"]
<colgroup><col><col><col><col span="10"></colgroup><tbody>[TR]
[TD][/TD]
[TD]Deliverable Date[/TD]
[TD]State[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Release Pilot[/TD]
[TD="align: right"]02/01/2015[/TD]
[TD]AZ, NM, WI[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Code Freeze[/TD]
[TD="align: right"]02/01/2015[/TD]
[TD]WI, MI[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Desired Output[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Deliverable Date[/TD]
[TD]State[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Release Pilot[/TD]
[TD="align: right"]02/01/2015[/TD]
[TD]AZ[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Release Pilot[/TD]
[TD="align: right"]02/01/2015[/TD]
[TD]NM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"]this macro pulls out the states[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Release Pilot[/TD]
[TD="align: right"]02/01/2015[/TD]
[TD]WI[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Code Freeze[/TD]
[TD="align: right"]02/01/2015[/TD]
[TD]WI[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"]I am sorry I do not have time[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Code Freeze[/TD]
[TD="align: right"]02/01/2015[/TD]
[TD]MI[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"]to get it to your format[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"]Dim nn(5), state(20)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"] rownum = 20[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"] For j = 2 To 3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"] For k = 1 To 100[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 6"] If Mid(Cells(j, 3), k, 1) = "," Then mmm = k: GoTo 50[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"] GoTo 100[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"]50 tot = tot + 1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]AZ[/TD]
[TD]NM[/TD]
[TD]WI[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"] nn(tot) = mmm[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]WI[/TD]
[TD]MI[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"]100 Next k[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"]nn(tot + 1) = nn(tot) + 4[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"] For z = 1 To tot + 1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 4"] xxx = Mid(Cells(j, 3), nn(z) - 2, 2)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"] Cells(rownum, z) = xxx[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD] Next z[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"] nn(1) = ""[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"] nn(2) = ""[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD] tot = 0[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"] rownum = rownum + 1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD] Next j[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"]200 End Sub[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Mick - Thank you so much, this is perfect. The data that I will eventually be using will have more than 3 columns...which parts of the string would I have to modify to adapt this to say 20 columns? I can keep the state column constant in the 3rd column but there will be additional data points. Thanks again,


Matt
 
Upvote 0
Try something like this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG08Jan24
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Sp [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray(), c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
'[COLOR="Green"][B]ReDim Ray(1 To 3, 1 To 1)[/B][/COLOR]


'[COLOR="Green"][B]for 20 columns:-[/B][/COLOR]
ReDim Ray(1 To 20, 1 To 1)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Sp = Split(Dn.Offset(, 2).Value, ", ")
        '[COLOR="Green"][B]ReDim Preserve Ray(1 To 3, 1 To UBound(Ray, 2) + UBound(Sp) + 1)[/B][/COLOR]
        
        '[COLOR="Green"][B]for 20 columns:-[/B][/COLOR]
        ReDim Preserve Ray(1 To 20, 1 To UBound(Ray, 2) + UBound(Sp) + 1)
   
            [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
                c = c + 1
                Ray(1, c) = Dn.Value
                Ray(2, c) = DateValue(Dn.Offset(, 1).Value)
                Ray(3, c) = Sp(n)
                Ray(4, c) = Dn.Offset(, 3)
                Ray(5, c) = Dn.Offset(, 4)
                Ray(6, c) = Dn.Offset(, 5)
                 '[COLOR="Green"][B]Repeat to 20, as below[/B][/COLOR]
                Ray(20, c) = Dn.Offset(, 19)
            [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Dn


'[COLOR="Green"][B]Range("A2").Resize(c, 3).Value = Application.Transpose(Ray)[/B][/COLOR]
'[COLOR="Green"][B]for 20 columns:-[/B][/COLOR]
Range("A2").Resize(c, 20).Value = Application.Transpose(Ray)
Range("B2").Resize(c).NumberFormat = "0"
Range("B2").Resize(c).NumberFormat = "dd/mm/yyy"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Moss, Here is another alternative that will works for x number of rows:

Code: 
Sub moss84()
Dim i As Long, j As Long, lr As Long, rins As Integer
Dim ws As Worksheet, rng As Range, nrng As Range
Dim sp As Variant, nsp As Variant

Set ws = Sheets("Sheet2")
lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("C2:C" & lr)

Application.ScreenUpdating = False

For Each Cell In rng
    j = j + Len(Cell) - Len(Replace(Cell.Text, ",", ""))
Next

Set nrng = Range("C2:C" & j + lr)
    
For Each Cell In nrng
    If InStr(Cell, ",") <> 0 Then
        sp = Split(Cell.Text, ", ")
        nsp = Range("A" & Cell.Row & ":B" & Cell.Row)
        rins = UBound(sp)
        Cell.Offset(1).Range("A1:A" & rins).Select
        Selection.EntireRow.Insert shift:=xlShiftDown
        Range("A" & Cell.Row & ":B" & Cell.Row).Resize(rins + 1) = nsp
        Range("C" & Cell.Row).Resize(rins + 1) = Application.Transpose(sp)
    End If
Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thanks Ombir - appreciate the code it works great. One thing that is not working is that the macro identifies the states and creates new records but it does not copy the data to the right of the state column. It does, however, repeat the data to the left of state column. Apologize for multiple request but Im not sure how to fix this.

Thanks, Matt!
 
Upvote 0
To clarify, I have data in columns D:H that I want to be repeated for each state record that is split out from column C....if that makes sense?

Thanks again!


moss84 said:
Thanks Ombir - appreciate the code it works great. One thing that is not working is that the macro identifies the states and creates new records but it does not copy the data to the right of the state column. It does, however, repeat the data to the left of state column. Apologize for multiple request but Im not sure how to fix this.

Thanks, Matt!
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Question Question
VBA Code for Named Ranges
Replies
2
Views
582
fishandtril
F
M
  • Question Question
Add "x" to a matrix
Replies
2
Views
190
Monikbor
M
A
  • Solved
take amount from last row in listbox on form and put into next column
Replies
7
Views
119
Abdo
A
D
  • Solved
Need help creating a formula based on VBA function!
Replies
5
Views
322
Trixterz
T
U
  • Solved
VBA To Add rows to TABLE based on a cells value
Replies
3
Views
209
igold
igold

Forum statistics

Threads
1,223,240
Messages
6,170,951
Members
452,368
Latest member
jayp2104

Share this page

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