W
weston.perkins
I presently have a code to search for a counter in column B on my
selected page. The counter signals where to take the last row above
the counter and insert a new row with copied formats and formulas.
This works, however, several of the rows above that have formulas that
dont populate correctly due to their links between the rows. What I
need is help with selecting a range of rows (12 to be exact) above my
counter at the end of my list, and then copy those 12 rows exactly and
insert them between the the counter and the 12 rows copied. Currently
the code I have only takes a single row 12 rows above the counter and
inserts a copy of that row above the counter. I tried using a macro
to use this application 12 times in a row to simulate what I need done
in one step, but this caused the formula errors that did not populate
correctly. If anyone could give me some insight to altering the code
to select a range of 12 rows then insert those above the counter, it
would be greatly appreciated.
Below is the code:
Sub InsertNewProductListInfo()
Dim objCurrentSheet
Dim rngCopiedCells
Dim rngInsertedCells
Dim rngLastRow
Dim intRowIndex
Dim strFromRange
Dim strToRange
Dim strLastRowRange
Dim dtLastDayOfMonth
Dim index
Set objCurrentSheet = Sheets(ActiveSheet.Name)
For counter = 1 To objCurrentSheet.Rows.Count 'Start of first Loop
Set curCell = objCurrentSheet.Rows(counter).Cells(2)
'MsgBox Worksheets("Invent - Rev").Rows(counter).Cells(2).Text
If Trim(LCase((curCell.Text))) = "product list info" Then
'12 Rows above Product List Info row
intRowIndex = counter - 12
'Gets cells that will make up each of the ranges
strFromRange = "A" & intRowIndex & ":FO" & intRowIndex
strToRange = "A" & counter & ":FO" & counter
strLastRowRange = "A" & (counter) & ":FO" & (counter)
'Set the range of cells used to copy into the new row
Set rngCopiedCells = objCurrentSheet.Range(strFromRange)
'Insert a row above the Product List Info line
objCurrentSheet.Rows(counter).Insert (xlDown)
'Range copied to
Set rngInsertedCells = objCurrentSheet.Range(strToRange)
'Range for last row
Set rngLastRowRange =
objCurrentSheet.Range(strLastRowRange)
'Copy the source range with the second range as the
destination
rngCopiedCells.Copy (rngInsertedCells)
rngCopiedCells.Copy (rngLastRowRange)
Exit Sub
End If
Next counter 'End of first loop
End Sub
selected page. The counter signals where to take the last row above
the counter and insert a new row with copied formats and formulas.
This works, however, several of the rows above that have formulas that
dont populate correctly due to their links between the rows. What I
need is help with selecting a range of rows (12 to be exact) above my
counter at the end of my list, and then copy those 12 rows exactly and
insert them between the the counter and the 12 rows copied. Currently
the code I have only takes a single row 12 rows above the counter and
inserts a copy of that row above the counter. I tried using a macro
to use this application 12 times in a row to simulate what I need done
in one step, but this caused the formula errors that did not populate
correctly. If anyone could give me some insight to altering the code
to select a range of 12 rows then insert those above the counter, it
would be greatly appreciated.
Below is the code:
Sub InsertNewProductListInfo()
Dim objCurrentSheet
Dim rngCopiedCells
Dim rngInsertedCells
Dim rngLastRow
Dim intRowIndex
Dim strFromRange
Dim strToRange
Dim strLastRowRange
Dim dtLastDayOfMonth
Dim index
Set objCurrentSheet = Sheets(ActiveSheet.Name)
For counter = 1 To objCurrentSheet.Rows.Count 'Start of first Loop
Set curCell = objCurrentSheet.Rows(counter).Cells(2)
'MsgBox Worksheets("Invent - Rev").Rows(counter).Cells(2).Text
If Trim(LCase((curCell.Text))) = "product list info" Then
'12 Rows above Product List Info row
intRowIndex = counter - 12
'Gets cells that will make up each of the ranges
strFromRange = "A" & intRowIndex & ":FO" & intRowIndex
strToRange = "A" & counter & ":FO" & counter
strLastRowRange = "A" & (counter) & ":FO" & (counter)
'Set the range of cells used to copy into the new row
Set rngCopiedCells = objCurrentSheet.Range(strFromRange)
'Insert a row above the Product List Info line
objCurrentSheet.Rows(counter).Insert (xlDown)
'Range copied to
Set rngInsertedCells = objCurrentSheet.Range(strToRange)
'Range for last row
Set rngLastRowRange =
objCurrentSheet.Range(strLastRowRange)
'Copy the source range with the second range as the
destination
rngCopiedCells.Copy (rngInsertedCells)
rngCopiedCells.Copy (rngLastRowRange)
Exit Sub
End If
Next counter 'End of first loop
End Sub