find text then insert new row above
 

Going round in circles here.... can anyone help please?

I need a macro to do this:

Search down column B for some specific text and then insert a new row
immediately above the found cell. The new row must copy the formulas and
formatting (but not the values) of the row above the found cell.

So, find text "last risk above" in column B - let's say this is cell B40.
Macro then copies the formatting and formulas of B39 to a new row between
B39 and B40.

Thanks in advance,

Nick

find text then insert new row above
 

Hi Nick,

Try:

'=============
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Const sStr As String = "last risk above"

Set WB = ActiveWorkbook '<<==== CHANGE
Set SH = WB.Sheets("Sheet3") '<<==== CHANGE

Set rng = SH.Columns("B:B").Find(What:=sStr, _
After:=Range("B1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
With rng
.EntireRow.Insert
.Offset(-2).Copy
.Offset(-1).PasteSpecial Paste:=xlFormulas, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
End With
End If
End Sub
'<<=============


---
Regards,
Norman


"Nick Smith" wrote in message
...
Going round in circles here.... can anyone help please?

I need a macro to do this:

Search down column B for some specific text and then insert a new row
immediately above the found cell. The new row must copy the formulas and
formatting (but not the values) of the row above the found cell.

So, find text "last risk above" in column B - let's say this is cell B40.
Macro then copies the formatting and formulas of B39 to a new row between
B39 and B40.

Thanks in advance,

Nick

find text then insert new row above
 

Hi Norman,

Tried it but nothing happens. Made some amends as below, but still nothing.
Not even an error. Any ideas as I am confused!

Sub InsertNewRiskInStatusReport()

Dim SH As Worksheet
Dim rng As Range
Const sStr As String = "Last Risk Above"

Set SH = ThisWorkbook.Sheets("Status Report") '<<==== CHANGE

Set rng = SH.Columns("B:B").Find(What:=sStr, _
After:=Range("B1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
With rng
.EntireRow.Insert
.Offset(-2).Copy
.Offset(-1).PasteSpecial Paste:=xlFormulas, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
End With
End If
End Sub
'<<=============

"Norman Jones" wrote:

Hi Nick,

Try:

'=============
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Const sStr As String = "last risk above"

Set WB = ActiveWorkbook '<<==== CHANGE
Set SH = WB.Sheets("Sheet3") '<<==== CHANGE

Set rng = SH.Columns("B:B").Find(What:=sStr, _
After:=Range("B1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
With rng
.EntireRow.Insert
.Offset(-2).Copy
.Offset(-1).PasteSpecial Paste:=xlFormulas, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
End With
End If
End Sub
'<<=============


---
Regards,
Norman


"Nick Smith" wrote in message
...
Going round in circles here.... can anyone help please?

I need a macro to do this:

Search down column B for some specific text and then insert a new row
immediately above the found cell. The new row must copy the formulas and
formatting (but not the values) of the row above the found cell.

So, find text "last risk above" in column B - let's say this is cell B40.
Macro then copies the formatting and formulas of B39 to a new row between
B39 and B40.

Thanks in advance,

Nick

find text then insert new row above
 

Hi Nick,

Tried it but nothing happens

The code works for me in my test workbook.

What happens if you try to find "Last Risk Above" manually?
Is this text present in Column B?
Where is the code placed?

---
Regards,
Norman



"Nick Smith" wrote in message
...
Hi Norman,

Tried it but nothing happens. Made some amends as below, but still
nothing.
Not even an error. Any ideas as I am confused!

Sub InsertNewRiskInStatusReport()

Dim SH As Worksheet
Dim rng As Range
Const sStr As String = "Last Risk Above"

Set SH = ThisWorkbook.Sheets("Status Report") '<<==== CHANGE

Set rng = SH.Columns("B:B").Find(What:=sStr, _
After:=Range("B1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
With rng
.EntireRow.Insert
.Offset(-2).Copy
.Offset(-1).PasteSpecial Paste:=xlFormulas, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
End With
End If
End Sub
'<<=============

find text then insert new row above
 

The text in B40 was merged with C, D and E 40. De-merged B40 and it inserts
a row now with formatting and formulas, but it has not retained the merged
characteristics of the precedding rows. Can this be included in the new row?

Thanks,

Nick

"Norman Jones" wrote:

Hi Nick,

Tried it but nothing happens

The code works for me in my test workbook.

What happens if you try to find "Last Risk Above" manually?
Is this text present in Column B?
Where is the code placed?

---
Regards,
Norman



"Nick Smith" wrote in message
...
Hi Norman,

Tried it but nothing happens. Made some amends as below, but still
nothing.
Not even an error. Any ideas as I am confused!

Sub InsertNewRiskInStatusReport()

Dim SH As Worksheet
Dim rng As Range
Const sStr As String = "Last Risk Above"

Set SH = ThisWorkbook.Sheets("Status Report") '<<==== CHANGE

Set rng = SH.Columns("B:B").Find(What:=sStr, _
After:=Range("B1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
With rng
.EntireRow.Insert
.Offset(-2).Copy
.Offset(-1).PasteSpecial Paste:=xlFormulas, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
End With
End If
End Sub
'<<=============

find text then insert new row above
 

Hi Nick,

The text in B40 was merged with C, D and E 40. De-merged B40
and it inserts a row now with formatting and formulas, but it has not
retained the merged characteristics of the precedding rows.
Can this be included in the new row?

Try:
'=============
Public Sub InsertNewRiskInStatusReport()
Sub InsertNewRiskInStatusReport()
Dim SH As Worksheet
Dim rng As Range
Const sStr As String = "Last Risk Above"

Set SH = ThisWorkbook.Sheets("Status Report")

Set rng = SH.Columns("B:D").Find(What:=sStr, _
After:=Range("B1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
With rng
.EntireRow.Insert
.Offset(-2).Resize(1, 3).Copy Destination:=.Offset(-1)
End With
End If
End Sub
'<<=============


---
Regards,
Norman

find text then insert new row above
 

Hi Nick,

Change:

Public Sub InsertNewRiskInStatusReport()
Sub InsertNewRiskInStatusReport()

to

Public Sub InsertNewRiskInStatusReport()


---
Regards,
Norman

find text then insert new row above
 

Sorry to be a pain; perhaps I should have been mre descriptive from the
start!!!

There are merged cells further along the row that need to be copied down
too, which could be hard coded I suppose, but I would prefer for it to
automatically copy all formatting - conditional formatting, formulas, cell
borders, merged cells - but not the values. It is also copying the value in
column B but not other columns and not copying the cell borders down.

If hard coding is required, the following columns are merged in the row:
A-E, F and G, J-N

Can this be done or am I asking too much of Excel now?

Regards,

Nick

"Norman Jones" wrote:

Hi Nick,

The text in B40 was merged with C, D and E 40. De-merged B40
and it inserts a row now with formatting and formulas, but it has not
retained the merged characteristics of the precedding rows.
Can this be included in the new row?

Try:
'=============
Public Sub InsertNewRiskInStatusReport()
Sub InsertNewRiskInStatusReport()
Dim SH As Worksheet
Dim rng As Range
Const sStr As String = "Last Risk Above"

Set SH = ThisWorkbook.Sheets("Status Report")

Set rng = SH.Columns("B:D").Find(What:=sStr, _
After:=Range("B1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
With rng
.EntireRow.Insert
.Offset(-2).Resize(1, 3).Copy Destination:=.Offset(-1)
End With
End If
End Sub
'<<=============


---
Regards,
Norman

find text then insert new row above
 

Noticed that one myself and made the change already - it seems I am picking
up some excel skills along the way with this project I'm doing!

"Norman Jones" wrote:

Hi Nick,

Change:

Public Sub InsertNewRiskInStatusReport()
Sub InsertNewRiskInStatusReport()

to

Public Sub InsertNewRiskInStatusReport()


---
Regards,
Norman

find text then insert new row above
 

Hi Nick,

Sorry to be a pain; perhaps I should have been mre descriptive from the
start!!!

You are not a pain but, in my experience, merged cells frequently have this
capacity. Personally, I avoid merged cells like the plague and tend to use
the centre across selection option.

You say:

If hard coding is required, the following columns are merged in the row:
A-E, F and G, J-N

However, you previously indicated:

The text in B40 was merged with C, D and E 40


Perhaps you could clarify?

---
Regards,
Norman



"Nick Smith" wrote in message
...
Sorry to be a pain; perhaps I should have been mre descriptive from the
start!!!

There are merged cells further along the row that need to be copied down
too, which could be hard coded I suppose, but I would prefer for it to
automatically copy all formatting - conditional formatting, formulas, cell
borders, merged cells - but not the values. It is also copying the value
in
column B but not other columns and not copying the cell borders down.

If hard coding is required, the following columns are merged in the row:
A-E, F and G, J-N

Can this be done or am I asking too much of Excel now?

Regards,

Nick