Loop in Excel
 

Jim Thomlinson gave me the following code regarding a loop routine.
I also need to paste in two rows of text in from another sheet in the space
created by inserting 3 rows (based on below)

Would really appreciate your help.

Kind regards,

David


Sub DeleteStuff()
Dim rngToSearch As Range
Dim rngFound As Range
Dim strFirstAddress As String

Set rngToSearch = Sheets("Sheet1").Columns("A")
Set rngFound = rngToSearch.Find(What:="x", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "Sorry nothin found"
Else
strFirstAddress = rngFound.Address
Do
rngFound.Offset(1, 0).Resize(3).EntireRow.Insert
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If
End Sub

--
Thanks for your help

Loop in Excel
 

Sub DeleteStuff()
Dim rngToSearch As Range
Dim rngFound As Range
Dim strFirstAddress As String

Set rngToSearch = Sheets("Sheet1").Columns("A")
Set rngFound = rngToSearch.Find(What:="x", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "Sorry nothin found"
Else
strFirstAddress = rngFound.Address
Do
rngFound.Offset(1, 0).Resize(3).EntireRow.Insert
worksheets("sheet3").Range("3:4").copy _
rngFound.Offset(1,0).EntireRow
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If
End Sub

--
Regards,
Tom Ogilvy


"David" wrote:

Jim Thomlinson gave me the following code regarding a loop routine.
I also need to paste in two rows of text in from another sheet in the space
created by inserting 3 rows (based on below)

Would really appreciate your help.

Kind regards,

David


Sub DeleteStuff()
Dim rngToSearch As Range
Dim rngFound As Range
Dim strFirstAddress As String

Set rngToSearch = Sheets("Sheet1").Columns("A")
Set rngFound = rngToSearch.Find(What:="x", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "Sorry nothin found"
Else
strFirstAddress = rngFound.Address
Do
rngFound.Offset(1, 0).Resize(3).EntireRow.Insert
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If
End Sub

--
Thanks for your help

Loop in Excel
 

Tom,

Thanks a million for that- just a question that when the formula finds the
variable "X" per the code here it inserts 3 lines from the next row- I need
it to insert from where it finds the varaible- could you advise what change
is required?

--
Thanks for your help


"Tom Ogilvy" wrote:

Sub DeleteStuff()
Dim rngToSearch As Range
Dim rngFound As Range
Dim strFirstAddress As String

Set rngToSearch = Sheets("Sheet1").Columns("A")
Set rngFound = rngToSearch.Find(What:="x", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "Sorry nothin found"
Else
strFirstAddress = rngFound.Address
Do
rngFound.Offset(1, 0).Resize(3).EntireRow.Insert
worksheets("sheet3").Range("3:4").copy _
rngFound.Offset(1,0).EntireRow
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If
End Sub

--
Regards,
Tom Ogilvy


"David" wrote:

Jim Thomlinson gave me the following code regarding a loop routine.
I also need to paste in two rows of text in from another sheet in the space
created by inserting 3 rows (based on below)

Would really appreciate your help.

Kind regards,

David


Sub DeleteStuff()
Dim rngToSearch As Range
Dim rngFound As Range
Dim strFirstAddress As String

Set rngToSearch = Sheets("Sheet1").Columns("A")
Set rngFound = rngToSearch.Find(What:="x", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "Sorry nothin found"
Else
strFirstAddress = rngFound.Address
Do
rngFound.Offset(1, 0).Resize(3).EntireRow.Insert
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If
End Sub

--
Thanks for your help

Loop in Excel
 

Sub DeleteStuff()
Dim rngToSearch As Range
Dim rngFound As Range
Dim strFirstAddress As String

Set rngToSearch = Sheets("Sheet1").Columns("A")
Set rngFound = rngToSearch.Find(What:="x", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "Sorry nothin found"
Else
strFirstAddress = rngFound.Offset(3, 0).Address
Do
rngFound.Offset.Resize(3).EntireRow.Insert
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If
End Sub



--
Regards,
Tom Ogilvy


"David" wrote in message
...
Tom,

Thanks a million for that- just a question that when the formula finds the
variable "X" per the code here it inserts 3 lines from the next row- I
need
it to insert from where it finds the varaible- could you advise what
change
is required?

--
Thanks for your help


"Tom Ogilvy" wrote:

Sub DeleteStuff()
Dim rngToSearch As Range
Dim rngFound As Range
Dim strFirstAddress As String

Set rngToSearch = Sheets("Sheet1").Columns("A")
Set rngFound = rngToSearch.Find(What:="x", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "Sorry nothin found"
Else
strFirstAddress = rngFound.Address
Do
rngFound.Offset(1, 0).Resize(3).EntireRow.Insert
worksheets("sheet3").Range("3:4").copy _
rngFound.Offset(1,0).EntireRow
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If
End Sub

--
Regards,
Tom Ogilvy


"David" wrote:

Jim Thomlinson gave me the following code regarding a loop routine.
I also need to paste in two rows of text in from another sheet in the
space
created by inserting 3 rows (based on below)

Would really appreciate your help.

Kind regards,

David


Sub DeleteStuff()
Dim rngToSearch As Range
Dim rngFound As Range
Dim strFirstAddress As String

Set rngToSearch = Sheets("Sheet1").Columns("A")
Set rngFound = rngToSearch.Find(What:="x", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "Sorry nothin found"
Else
strFirstAddress = rngFound.Address
Do
rngFound.Offset(1, 0).Resize(3).EntireRow.Insert
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If
End Sub

--
Thanks for your help