ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   inset rows and copy formatting , excel macro (https://www.excelbanter.com/excel-discussion-misc-queries/15964-inset-rows-copy-formatting-excel-macro.html)

sloanranger
inset rows and copy formatting , excel macro
 
i need a macro that inserts rows the same as the macro below but will
also copy the formatting and formula from the row above

Sub Macro1()
'-- Ken Wright, 2003-08-09
Application.ScreenUpdating = False
Dim numRows As Integer
Dim r As Long
Dim Rng As Range
Dim lastrw As Long
numRows = InputBox("How many Rows")
lastrw = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range(Cells(1, "A"), Cells(lastrw, "A"))
For r = Rng.Rows.Count To 1 Step -1
Rng.Rows(r + 1).Resize(numRows).EntireRow.Insert
Next r
Application.ScreenUpdating = True
End Sub

Dave Peterson
You're inserting x number of rows between row 1 and the last used cell column A?

if yes, then you can copy those rows, then come back and wipe out the constants
(leaving the formulas and formating).

Option Explicit
Sub Macro1A()
Dim numRows As Long
Dim iRow As Long
Dim LastRow As Long
Dim FirstRow As Long

numRows = Application.InputBox("How many Rows", Type:=1)

If numRows < 1 Then Exit Sub

Application.ScreenUpdating = False
With ActiveSheet
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(numRows).Insert
.Rows(iRow).Copy _
Destination:=.Rows(iRow + 1).Resize(numRows)
On Error Resume Next
.Rows(iRow + ).Resize(numRows) _
.Cells.SpecialCells(xlCellTypeConstants).ClearCont ents
On Error GoTo 0
Next iRow

End With
Application.ScreenUpdating = True
End Sub


sloanranger wrote:

i need a macro that inserts rows the same as the macro below but will
also copy the formatting and formula from the row above

Sub Macro1()
'-- Ken Wright, 2003-08-09
Application.ScreenUpdating = False
Dim numRows As Integer
Dim r As Long
Dim Rng As Range
Dim lastrw As Long
numRows = InputBox("How many Rows")
lastrw = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range(Cells(1, "A"), Cells(lastrw, "A"))
For r = Rng.Rows.Count To 1 Step -1
Rng.Rows(r + 1).Resize(numRows).EntireRow.Insert
Next r
Application.ScreenUpdating = True
End Sub

--

Dave Peterson

sloanranger
Dave,

thankyou very much for you efforts- the macro works great, unfortunatly
i am not formiliar with any of this VB language, although i am trying.
I would like to tailer the code somemore so it does exactley what i
need.

i have removed the clear constants bit as i do need these!!

Idealy i would like to insert rows between row5 and the last and also
if possible add the value of 110 to a cell in in each of the row
generated (not the originals),the cell in question is in column D, this
would be fantastic if you get it to work.

Thanks very much for you speedy reply, i have included your code that i
have ammended.


Sub Macro99()
Dim numRows As Long
Dim iRow As Long
Dim LastRow As Long
Dim FirstRow As Long


numRows = Application.InputBox("How many Rows", Type:=1)


If numRows < 1 Then Exit Sub


Application.ScreenUpdating = False
With ActiveSheet
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row


For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(numRows).Insert
.Rows(iRow).Copy _
Destination:=.Rows(iRow + 1).Resize(numRows)
On Error Resume Next
'.Rows(iRow + ).Resize(numRows)
'
..Cells.SpecialCells(xlCellTypeConstants).ClearCon tents
On Error GoTo 0
Next iRow


End With
Application.ScreenUpdating = True
End Sub


Regards
Lee sloan


Dave Peterson wrote:
You're inserting x number of rows between row 1 and the last used
cell column A?

if yes, then you can copy those rows, then come back and wipe out the
constants
(leaving the formulas and formating).

Option Explicit
Sub Macro1A()
Dim numRows As Long
Dim iRow As Long
Dim LastRow As Long
Dim FirstRow As Long

numRows = Application.InputBox("How many Rows", Type:=1)

If numRows < 1 Then Exit Sub

Application.ScreenUpdating = False
With ActiveSheet
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(numRows).Insert
.Rows(iRow).Copy _
Destination:=.Rows(iRow + 1).Resize(numRows)
On Error Resume Next
.Rows(iRow + ).Resize(numRows) _

..Cells.SpecialCells(xlCellTypeConstants).ClearCon tents
On Error GoTo 0
Next iRow

End With
Application.ScreenUpdating = True
End Sub


sloanranger wrote:

i need a macro that inserts rows the same as the macro below but
will
also copy the formatting and formula from the row above

Sub Macro1()
'-- Ken Wright, 2003-08-09
Application.ScreenUpdating = False
Dim numRows As Integer
Dim r As Long
Dim Rng As Range
Dim lastrw As Long
numRows = InputBox("How many Rows")
lastrw = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range(Cells(1, "A"), Cells(lastrw, "A"))
For r = Rng.Rows.Count To 1 Step -1
Rng.Rows(r + 1).Resize(numRows).EntireRow.Insert
Next r
Application.ScreenUpdating = True
End Sub

--

Dave Peterson

Dave Peterson
How about:

Option Explicit

Sub Macro99()
Dim numRows As Long
Dim iRow As Long
Dim LastRow As Long
Dim FirstRow As Long

numRows = Application.InputBox("How many Rows", Type:=1)

If numRows < 1 Then Exit Sub

Application.ScreenUpdating = False
With ActiveSheet
FirstRow = 5 '<--
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(numRows).Insert
.Rows(iRow).Copy _
Destination:=.Rows(iRow + 1).Resize(numRows)
.Cells(iRow + 1, "D").Resize(numRows) = 110
'On Error Resume Next
'.Rows(iRow + ).Resize(numRows)
'.Cells.SpecialCells(xlCellTypeConstants).ClearCon tents
'On Error GoTo 0
Next iRow
End With
Application.ScreenUpdating = True
End Sub



sloanranger wrote:

Dave,

thankyou very much for you efforts- the macro works great, unfortunatly
i am not formiliar with any of this VB language, although i am trying.
I would like to tailer the code somemore so it does exactley what i
need.

i have removed the clear constants bit as i do need these!!

Idealy i would like to insert rows between row5 and the last and also
if possible add the value of 110 to a cell in in each of the row
generated (not the originals),the cell in question is in column D, this
would be fantastic if you get it to work.

Thanks very much for you speedy reply, i have included your code that i
have ammended.

Sub Macro99()
Dim numRows As Long
Dim iRow As Long
Dim LastRow As Long
Dim FirstRow As Long

numRows = Application.InputBox("How many Rows", Type:=1)

If numRows < 1 Then Exit Sub

Application.ScreenUpdating = False
With ActiveSheet
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(numRows).Insert
.Rows(iRow).Copy _
Destination:=.Rows(iRow + 1).Resize(numRows)
On Error Resume Next
'.Rows(iRow + ).Resize(numRows)
'
.Cells.SpecialCells(xlCellTypeConstants).ClearCont ents
On Error GoTo 0
Next iRow

End With
Application.ScreenUpdating = True
End Sub

Regards
Lee sloan

Dave Peterson wrote:
You're inserting x number of rows between row 1 and the last used
cell column A?

if yes, then you can copy those rows, then come back and wipe out the
constants
(leaving the formulas and formating).

Option Explicit
Sub Macro1A()
Dim numRows As Long
Dim iRow As Long
Dim LastRow As Long
Dim FirstRow As Long

numRows = Application.InputBox("How many Rows", Type:=1)

If numRows < 1 Then Exit Sub

Application.ScreenUpdating = False
With ActiveSheet
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(numRows).Insert
.Rows(iRow).Copy _
Destination:=.Rows(iRow + 1).Resize(numRows)
On Error Resume Next
.Rows(iRow + ).Resize(numRows) _

.Cells.SpecialCells(xlCellTypeConstants).ClearCont ents
On Error GoTo 0
Next iRow

End With
Application.ScreenUpdating = True
End Sub


sloanranger wrote:

i need a macro that inserts rows the same as the macro below but
will
also copy the formatting and formula from the row above

Sub Macro1()
'-- Ken Wright, 2003-08-09
Application.ScreenUpdating = False
Dim numRows As Integer
Dim r As Long
Dim Rng As Range
Dim lastrw As Long
numRows = InputBox("How many Rows")
lastrw = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range(Cells(1, "A"), Cells(lastrw, "A"))
For r = Rng.Rows.Count To 1 Step -1
Rng.Rows(r + 1).Resize(numRows).EntireRow.Insert
Next r
Application.ScreenUpdating = True
End Sub

--

Dave Peterson

--

Dave Peterson

sloanranger
not really understanding what you have wrote, and maybe i have not
explained myself correctly, the bit about adding 110, should be value
in original cell (as it is a constant) +110, example original value in
D10=220, then answer required D10=330, hope this explains, sorry to be
a pest but could provide the completed code as i am not sure ware you
mods are to be added.

Cheers

Lee Sloan

Dave Peterson
Now I am confused.

Say the D10 holds 123. And you insert two rows.

The existing D10 stays 123???
The new D11 becomes 123+110= 233???
The new D12 becomes 123+110+110=343 or 123+110=233???




sloanranger wrote:

not really understanding what you have wrote, and maybe i have not
explained myself correctly, the bit about adding 110, should be value
in original cell (as it is a constant) +110, example original value in
D10=220, then answer required D10=330, hope this explains, sorry to be
a pest but could provide the completed code as i am not sure ware you
mods are to be added.

Cheers

Lee Sloan

--

Dave Peterson

sloanranger
i will only ever need to insert one row so d11=233 is correct

Lee Sloan

Dave Peterson
Even if you insert more than one row, this just adds 110 to the value in that
original cell.

Option Explicit
Sub Macro99()
Dim numRows As Long
Dim iRow As Long
Dim LastRow As Long
Dim FirstRow As Long

numRows = Application.InputBox("How many Rows", Type:=1)

If numRows < 1 Then Exit Sub

Application.ScreenUpdating = False
With ActiveSheet
FirstRow = 5 '<--
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(numRows).Insert
.Rows(iRow).Copy _
Destination:=.Rows(iRow + 1).Resize(numRows)
If IsNumeric(.Cells(iRow, "D").Value) Then
.Cells(iRow + 1, "D").Resize(numRows).Value _
= .Cells(iRow, "D").Value + 110
End If
'On Error Resume Next
'.Rows(iRow + ).Resize(numRows)
'.Cells.SpecialCells(xlCellTypeConstants).ClearCon tents
'On Error GoTo 0
Next iRow
End With
Application.ScreenUpdating = True
End Sub

sloanranger wrote:

i will only ever need to insert one row so d11=233 is correct

Lee Sloan

--

Dave Peterson

sloanranger
Works a treat, thanks very much

Lee Sloan

sloanranger
I have one more request,

i need to expand on the macro you wrote, this time can you make it turn
column X into a colour based on a number in column W

the colours i need are red, blue, yellow and green and the are
determined by the numbers 4,3,2 and 1 respectively.

example

X5=35mv
X6=70ml
X7=35ml
X8=70mv

dont worry about what X contain, but they must stay (they are the
result of a formula)

and

W5=4
W6=3
W7=2
W8=1

therefore X5 colorindex should be red, X6 should be blue, X7 should be
yellow and X8 should be green

and all this needs to be applied before the insert and copy loop starts

Hope you can help

Lee Sloan

Dave Peterson
Just the new rows?

You'll have to record a macro to find the colors you want to use--I just used 4,
3, 2, 1 (Not close to what you want--but there are lots of shades of green.)

Option Explicit
Sub Macro99()
Dim numRows As Long
Dim iRow As Long
Dim LastRow As Long
Dim FirstRow As Long
Dim myColorIndex As Long

numRows = Application.InputBox("How many Rows", Type:=1)

If numRows < 1 Then Exit Sub

Application.ScreenUpdating = False
With ActiveSheet
FirstRow = 5 '<--
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(numRows).Insert
.Rows(iRow).Copy _
Destination:=.Rows(iRow + 1).Resize(numRows)
If IsNumeric(.Cells(iRow, "D").Value) Then
.Cells(iRow + 1, "D").Resize(numRows).Value _
= .Cells(iRow, "D").Value + 110
End If
Select Case .Cells(iRow, "W").Value
Case Is = 1: myColorIndex = 4
Case Is = 2: myColorIndex = 3
Case Is = 3: myColorIndex = 2
Case Is = 4: myColorIndex = 1
Case Else
myColorIndex = xlNone
End Select
.Cells(iRow + 1, "x").Resize(numRows).Interior.ColorIndex _
= myColorIndex
Next iRow
End With
Application.ScreenUpdating = True
End Sub

sloanranger wrote:

I have one more request,

i need to expand on the macro you wrote, this time can you make it turn
column X into a colour based on a number in column W

the colours i need are red, blue, yellow and green and the are
determined by the numbers 4,3,2 and 1 respectively.

example

X5=35mv
X6=70ml
X7=35ml
X8=70mv

dont worry about what X contain, but they must stay (they are the
result of a formula)

and

W5=4
W6=3
W7=2
W8=1

therefore X5 colorindex should be red, X6 should be blue, X7 should be
yellow and X8 should be green

and all this needs to be applied before the insert and copy loop starts

Hope you can help

Lee Sloan

--

Dave Peterson

sloanranger
are you asking if i only need this for the new rows?

If so the answer is no, i need the colours to be applied before the new
rows are inserted

Lee Sloan

sloanranger
ive managed to resolve this one myself, i have move the select case
stuff before the isnumeric and it works.

Cheers

Lee SLoan

Dave Peterson
Glad you got it working, but if all you did was move those sections around, then
that didn't change anything significant.



sloanranger wrote:

ive managed to resolve this one myself, i have move the select case
stuff before the isnumeric and it works.

Cheers

Lee SLoan

--

Dave Peterson


All times are GMT +1. The time now is 07:20 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com