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

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

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

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
'<<=============

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
'<<=============

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