Hello,

I need some help with searching each row for the word 'Contact' in column B
and when found I want to insert a blank new row just above the row with the
word 'Contact'

Thanks you in advance for any help
James

Try this macro James

Sub test1()
Dim Rng As Range
Dim findstring As String
findstring = "Contact"
Set Rng = Range("B:B").Find(What:=findstring, After:=Range("B65536"), LookAt:=xlWhole)
While Not Rng Is Nothing
Rng.EntireRow.Insert
Set Rng = Range("B" & Rng.Row + 1 & ":B" & Rows.Count) _
.Find(What:=findstring, After:=Range("B65536"), LookAt:=xlWhole)
Wend
End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl



"James" wrote in message ...
Hello,

I need some help with searching each row for the word 'Contact' in column B and when found I want to insert a blank new row just
above the row with the word 'Contact'

Thanks you in advance for any help
James

Thanks a lot Ron it did the trick.
Could I askof you to help with removing all rows that that are empty in
columns A thr m. I need to do this first before adding the rows between each
file.
Thanks for your help
James

"Ron de Bruin" wrote in message
...
Try this macro James

Sub test1()
Dim Rng As Range
Dim findstring As String
findstring = "Contact"
Set Rng = Range("B:B").Find(What:=findstring, After:=Range("B65536"),
LookAt:=xlWhole)
While Not Rng Is Nothing
Rng.EntireRow.Insert
Set Rng = Range("B" & Rng.Row + 1 & ":B" & Rows.Count) _
.Find(What:=findstring, After:=Range("B65536"),
LookAt:=xlWhole)
Wend
End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl



"James" wrote in message
...
Hello,

I need some help with searching each row for the word 'Contact' in column
B and when found I want to insert a blank new row just above the row with
the word 'Contact'

Thanks you in advance for any help
James

Hi James

This macro will loop through all rows in the usedrange of the activesheet and delete
the row if A:M is empty

Sub Example1()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = Lastrow To Firstrow Step -1
If Application.CountA(.Range(.Cells(Lrow, "A"), .Cells(Lrow, "M"))) = 0 _
Then .Rows(Lrow).Delete
Next
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub



--
Regards Ron de Bruin
http://www.rondebruin.nl



"James" wrote in message ...
Thanks a lot Ron it did the trick.
Could I askof you to help with removing all rows that that are empty in columns A thr m. I need to do this first before adding the
rows between each file.
Thanks for your help
James

"Ron de Bruin" wrote in message ...
Try this macro James

Sub test1()
Dim Rng As Range
Dim findstring As String
findstring = "Contact"
Set Rng = Range("B:B").Find(What:=findstring, After:=Range("B65536"), LookAt:=xlWhole)
While Not Rng Is Nothing
Rng.EntireRow.Insert
Set Rng = Range("B" & Rng.Row + 1 & ":B" & Rows.Count) _
.Find(What:=findstring, After:=Range("B65536"), LookAt:=xlWhole)
Wend
End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl



"James" wrote in message ...
Hello,

I need some help with searching each row for the word 'Contact' in column B and when found I want to insert a blank new row just
above the row with the word 'Contact'

Thanks you in advance for any help
James

Thanks again for the help
James
"Ron de Bruin" wrote in message
...
Hi James

This macro will loop through all rows in the usedrange of the activesheet
and delete
the row if A:M is empty

Sub Example1()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = Lastrow To Firstrow Step -1
If Application.CountA(.Range(.Cells(Lrow, "A"), .Cells(Lrow,
"M"))) = 0 _
Then .Rows(Lrow).Delete
Next
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub



--
Regards Ron de Bruin
http://www.rondebruin.nl



"James" wrote in message
...
Thanks a lot Ron it did the trick.
Could I askof you to help with removing all rows that that are empty in
columns A thr m. I need to do this first before adding the rows between
each file.
Thanks for your help
James

"Ron de Bruin" wrote in message
...
Try this macro James

Sub test1()
Dim Rng As Range
Dim findstring As String
findstring = "Contact"
Set Rng = Range("B:B").Find(What:=findstring, After:=Range("B65536"),
LookAt:=xlWhole)
While Not Rng Is Nothing
Rng.EntireRow.Insert
Set Rng = Range("B" & Rng.Row + 1 & ":B" & Rows.Count) _
.Find(What:=findstring, After:=Range("B65536"),
LookAt:=xlWhole)
Wend
End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl



"James" wrote in message
...
Hello,

I need some help with searching each row for the word 'Contact' in
column B and when found I want to insert a blank new row just above the
row with the word 'Contact'

Thanks you in advance for any help
James

You are welcome



--
Regards Ron de Bruin
http://www.rondebruin.nl



"James" wrote in message ...
Thanks again for the help
James
"Ron de Bruin" wrote in message ...
Hi James

This macro will loop through all rows in the usedrange of the activesheet and delete
the row if A:M is empty

Sub Example1()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = Lastrow To Firstrow Step -1
If Application.CountA(.Range(.Cells(Lrow, "A"), .Cells(Lrow, "M"))) = 0 _
Then .Rows(Lrow).Delete
Next
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub



--
Regards Ron de Bruin
http://www.rondebruin.nl



"James" wrote in message ...
Thanks a lot Ron it did the trick.
Could I askof you to help with removing all rows that that are empty in columns A thr m. I need to do this first before adding
the rows between each file.
Thanks for your help
James

"Ron de Bruin" wrote in message ...
Try this macro James

Sub test1()
Dim Rng As Range
Dim findstring As String
findstring = "Contact"
Set Rng = Range("B:B").Find(What:=findstring, After:=Range("B65536"), LookAt:=xlWhole)
While Not Rng Is Nothing
Rng.EntireRow.Insert
Set Rng = Range("B" & Rng.Row + 1 & ":B" & Rows.Count) _
.Find(What:=findstring, After:=Range("B65536"), LookAt:=xlWhole)
Wend
End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl



"James" wrote in message ...
Hello,

I need some help with searching each row for the word 'Contact' in column B and when found I want to insert a blank new row
just above the row with the word 'Contact'

Thanks you in advance for any help
James