iterative macro to create rows and populate with copied data
iterative macro to create rows and populate with copied data
(OP)
The procedure I need to implement in Excel inserts 3 new rows below two existing rows in a spreadsheet, and then copies data from the row above those new rows into each of the new rows, and then moves down to the next "old row" inserts 3 new rows, and copies the second old row into these rows. For the next thousand (or more) old rows.
Interpolated values in the new rows (based on the values in the old rows above and below them) would be nice, but that is not essential. What is essential is to automate insertion of the rows containing the in-between values without harming the old values.
The purpose is to allow correction of depth recorded by a submerged instrument that creates a record every 15 minutes, using atmospheric pressure from a buoy that creates a record every hour.
In the macro recorder I first insert new rows
Rows("3:5").Select
Selection.Insert Shift:=xlDown
Rows("7:9").Select
Selection.Insert Shift:=xlDown
etc.
and then I copy the existing row into new rows
Rows("2:2").Select
Application.CutCopyMode = False
Selection.Copy
Rows("2:5").Select
ActiveSheet.Paste
Rows("6:6").Select
Application.CutCopyMode = False
Selection.Copy
Rows("6:9").Select
etc.
This works fine for a small worksheet, but is unscalable for a big one. How can I automate this process?
Interpolated values in the new rows (based on the values in the old rows above and below them) would be nice, but that is not essential. What is essential is to automate insertion of the rows containing the in-between values without harming the old values.
The purpose is to allow correction of depth recorded by a submerged instrument that creates a record every 15 minutes, using atmospheric pressure from a buoy that creates a record every hour.
In the macro recorder I first insert new rows
Rows("3:5").Select
Selection.Insert Shift:=xlDown
Rows("7:9").Select
Selection.Insert Shift:=xlDown
etc.
and then I copy the existing row into new rows
Rows("2:2").Select
Application.CutCopyMode = False
Selection.Copy
Rows("2:5").Select
ActiveSheet.Paste
Rows("6:6").Select
Application.CutCopyMode = False
Selection.Copy
Rows("6:9").Select
etc.
This works fine for a small worksheet, but is unscalable for a big one. How can I automate this process?





RE: iterative macro to create rows and populate with copied data
Sub ExpandData()
Dim iRow As Long
Dim s1 As String
Dim s2 As String
iRow = 2 'First Row of Data
Do While Len(Range("A" & iRow)) > 0
s1 = CStr(iRow + 1) & ":" & CStr(iRow + 3)
Rows(s1).Insert Shift:=xlDown
s2 = CStr(iRow) & ":" & CStr(iRow)
Rows(s2).Copy Rows(s1)
iRow = iRow + 4
Loop
MsgBox "Done!"
End Sub
Hope this helps...
DimensionalSolutions@Core.com
While I welcome e-mail messages, please post all thread activity in these forums for the benefit of all members.
RE: iterative macro to create rows and populate with copied data
Sub Example1()
'example 1
' select every-other row from 1 to 11, one at a time
' turn them yellow to leave evidence
'define variable x as integer
Dim x As Integer
'begin a loop, starting with 1 and
'ending with 11, increment x by 2
For x = 1 To 11 Step 2
'select row number x
Rows(x).Select
'fill it with solid light yellow
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
'continue looping with next value
Next x
End Sub
I struggled for a while and finally took this path:
Sub fabricate_data()
' select every-fourth row from 1 to 4400,
' Create a row below and copy data into it
' Create a row below and copy data into it
' Create a row below and copy data into it
'define variable x as integer
Dim x As Integer
'begin a loop, starting with 1 and
'ending with 4400, increment x by 4
For x = 1 To 4400 Step 4
'select row number x
Rows(x).Select
'create and fill new row with data in row above
'create and fill new row with data in row above
'create and fill new row with data in row above
With Selection
Application.CutCopyMode = False
Selection.Copy
.EntireRow.Insert
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
.EntireRow.Insert
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
.EntireRow.Insert
ActiveSheet.Paste
End With
'continue looping with next value
Next x
End Sub
Now ... the next challenge - how to embed a loop inside one or the other of these solutions that will create interpolated data based on the values in some but not all of those original rows?
And THANKS. I've been a spreadsheet person for decades and never actually automated anything before. This has been like turning on the lights.