Hello,

I have recorded a Macro which selects a worksheet, does a find on a word and
copies the data from another cell over it. I need to make my Macro Loop
until it finds the last ocurrance of the word.

If I put at the beginning of the macro Do Until, what expression do I put
after it?

Do I just put Loop at the end?

This is the macro:



Sheets("Book1").Select
Application.Goto Reference:="R1C1"
Cells.Find(What:="sub", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=
_
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(-2, 0).Range("A1").Select
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(-2, 6).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, -6).Range("A1:G1").Select
ActiveCell.Activate
Selection.Copy
Sheets("Book1NEW").Select
Application.Goto Reference:="R60000C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 4).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Cut Destination:=ActiveCell.Offset(0, -3).Range("A1:C1")
ActiveCell.Offset(0, -3).Range("A1:C1").Select
Sheets("Book1").Select
End Sub


Thanks in advance,
Martin

This snippet is adapted from the VBA help screen for the find method:

With ActiveSheet.Cells
Set c = .Find(2, LookIn:=xlValues) ''substitute your FIND expression
If Not c Is Nothing Then
firstaddress = c.Address
Do
c.Value = 5 ''change the '5' your expression(s)
to update the found cell
Set c = .FindNext(c)
If (Not (c Is Nothing)) Then
If c.Address = firstaddress Then c = Nothing
End If
Loop While (Not (c Is Nothing))
End If
End With

BTW, it wasn't clear to me if you want the loop to make the change for each
match (the code above is intended to help with that) or just for the final
ocurrance. If the latter, it would be easier just to start with the last
cell (IV65536) and change the SearchDirection argument in the Find to
xlPrevious)
HTH. --Bruce


"Martin" wrote:

Hello,

I have recorded a Macro which selects a worksheet, does a find on a word and
copies the data from another cell over it. I need to make my Macro Loop
until it finds the last ocurrance of the word.

If I put at the beginning of the macro Do Until, what expression do I put
after it?

Do I just put Loop at the end?

This is the macro:



Sheets("Book1").Select
Application.Goto Reference:="R1C1"
Cells.Find(What:="sub", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=
_
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(-2, 0).Range("A1").Select
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(-2, 6).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, -6).Range("A1:G1").Select
ActiveCell.Activate
Selection.Copy
Sheets("Book1NEW").Select
Application.Goto Reference:="R60000C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 4).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Cut Destination:=ActiveCell.Offset(0, -3).Range("A1:C1")
ActiveCell.Offset(0, -3).Range("A1:C1").Select
Sheets("Book1").Select
End Sub


Thanks in advance,
Martin

Thanks, but this seems a bit beyond my capabilities - I just like to record
macros and make simple changes.

I wasn't very clear - I need it to find each ocurrance and replace the
contents in turn, by re-running the macro. After it has replaced the last
entry and runs again, it comes up with a runtime error. This is why I need
some simple code that finishes the macro after all ocurrances have been
replaced. I am sure that a Do Until at the beginning and a Loop at the end
should work. I just don't know what to put after the Do Until.

The macro runs fine as it is but running it manually 500 time is a bit
wearsome!

I am not a VB writer so I need to keep it simple.

Thanks again,
Martin

"bpeltzer" wrote in message
...
This snippet is adapted from the VBA help screen for the find method:

With ActiveSheet.Cells
Set c = .Find(2, LookIn:=xlValues) ''substitute your FIND expression
If Not c Is Nothing Then
firstaddress = c.Address
Do
c.Value = 5 ''change the '5' your
expression(s)
to update the found cell
Set c = .FindNext(c)
If (Not (c Is Nothing)) Then
If c.Address = firstaddress Then c = Nothing
End If
Loop While (Not (c Is Nothing))
End If
End With

BTW, it wasn't clear to me if you want the loop to make the change for
each
match (the code above is intended to help with that) or just for the final
ocurrance. If the latter, it would be easier just to start with the last
cell (IV65536) and change the SearchDirection argument in the Find to
xlPrevious)
HTH. --Bruce


"Martin" wrote:

Hello,

I have recorded a Macro which selects a worksheet, does a find on a word
and
copies the data from another cell over it. I need to make my Macro Loop
until it finds the last ocurrance of the word.

If I put at the beginning of the macro Do Until, what expression do I
put
after it?

Do I just put Loop at the end?

This is the macro:



Sheets("Book1").Select
Application.Goto Reference:="R1C1"
Cells.Find(What:="sub", After:=ActiveCell, LookIn:=xlFormulas,
LookAt:=
_
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(-2, 0).Range("A1").Select
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(-2, 6).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, -6).Range("A1:G1").Select
ActiveCell.Activate
Selection.Copy
Sheets("Book1NEW").Select
Application.Goto Reference:="R60000C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 4).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Cut Destination:=ActiveCell.Offset(0, -3).Range("A1:C1")
ActiveCell.Offset(0, -3).Range("A1:C1").Select
Sheets("Book1").Select
End Sub


Thanks in advance,
Martin

Here are those simple changes incorporated into your recorded macro:
Sub test()

Sheets("Book1").Select
Application.Goto Reference:="R1C1"
Set c = ActiveSheet.Cells.Find(What:="sub", After:=ActiveCell,
LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False)
If Not c Is Nothing Then
firstaddress = c.Address
Do
c.Activate
ActiveCell.Offset(-2, 0).Range("A1").Select
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(-2, 6).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, -6).Range("A1:G1").Select
ActiveCell.Activate
Selection.Copy
Sheets("Book1NEW").Select
Application.Goto Reference:="R60000C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 4).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Cut Destination:=ActiveCell.Offset(0, -3).Range("A1:C1")
ActiveCell.Offset(0, -3).Range("A1:C1").Select
Sheets("Book1").Select
Set c = ActiveSheet.Cells.FindNext
If (Not (c Is Nothing)) Then
If c.Address = firstaddress Then c = Nothing
End If
Loop While (Not (c Is Nothing))
End If


End Sub

"Martin" wrote:

Thanks, but this seems a bit beyond my capabilities - I just like to record
macros and make simple changes.

I wasn't very clear - I need it to find each ocurrance and replace the
contents in turn, by re-running the macro. After it has replaced the last
entry and runs again, it comes up with a runtime error. This is why I need
some simple code that finishes the macro after all ocurrances have been
replaced. I am sure that a Do Until at the beginning and a Loop at the end
should work. I just don't know what to put after the Do Until.

The macro runs fine as it is but running it manually 500 time is a bit
wearsome!

I am not a VB writer so I need to keep it simple.

Thanks again,
Martin

"bpeltzer" wrote in message
...
This snippet is adapted from the VBA help screen for the find method:

With ActiveSheet.Cells
Set c = .Find(2, LookIn:=xlValues) ''substitute your FIND expression
If Not c Is Nothing Then
firstaddress = c.Address
Do
c.Value = 5 ''change the '5' your
expression(s)
to update the found cell
Set c = .FindNext(c)
If (Not (c Is Nothing)) Then
If c.Address = firstaddress Then c = Nothing
End If
Loop While (Not (c Is Nothing))
End If
End With

BTW, it wasn't clear to me if you want the loop to make the change for
each
match (the code above is intended to help with that) or just for the final
ocurrance. If the latter, it would be easier just to start with the last
cell (IV65536) and change the SearchDirection argument in the Find to
xlPrevious)
HTH. --Bruce


"Martin" wrote:

Hello,

I have recorded a Macro which selects a worksheet, does a find on a word
and
copies the data from another cell over it. I need to make my Macro Loop
until it finds the last ocurrance of the word.

If I put at the beginning of the macro Do Until, what expression do I
put
after it?

Do I just put Loop at the end?

This is the macro:



Sheets("Book1").Select
Application.Goto Reference:="R1C1"
Cells.Find(What:="sub", After:=ActiveCell, LookIn:=xlFormulas,
LookAt:=
_
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(-2, 0).Range("A1").Select
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(-2, 6).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, -6).Range("A1:G1").Select
ActiveCell.Activate
Selection.Copy
Sheets("Book1NEW").Select
Application.Goto Reference:="R60000C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 4).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Cut Destination:=ActiveCell.Offset(0, -3).Range("A1:C1")
ActiveCell.Offset(0, -3).Range("A1:C1").Select
Sheets("Book1").Select
End Sub


Thanks in advance,
Martin

Thank you very much I am most grateful. This worked a treat.


"bpeltzer" wrote in message
...
Here are those simple changes incorporated into your recorded macro:
Sub test()

Sheets("Book1").Select
Application.Goto Reference:="R1C1"
Set c = ActiveSheet.Cells.Find(What:="sub", After:=ActiveCell,
LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False)
If Not c Is Nothing Then
firstaddress = c.Address
Do
c.Activate
ActiveCell.Offset(-2, 0).Range("A1").Select
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(-2, 6).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, -6).Range("A1:G1").Select
ActiveCell.Activate
Selection.Copy
Sheets("Book1NEW").Select
Application.Goto Reference:="R60000C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 4).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Cut Destination:=ActiveCell.Offset(0, -3).Range("A1:C1")
ActiveCell.Offset(0, -3).Range("A1:C1").Select
Sheets("Book1").Select
Set c = ActiveSheet.Cells.FindNext
If (Not (c Is Nothing)) Then
If c.Address = firstaddress Then c = Nothing
End If
Loop While (Not (c Is Nothing))
End If


End Sub

"Martin" wrote:

Thanks, but this seems a bit beyond my capabilities - I just like to
record
macros and make simple changes.

I wasn't very clear - I need it to find each ocurrance and replace the
contents in turn, by re-running the macro. After it has replaced the
last
entry and runs again, it comes up with a runtime error. This is why I
need
some simple code that finishes the macro after all ocurrances have been
replaced. I am sure that a Do Until at the beginning and a Loop at the
end
should work. I just don't know what to put after the Do Until.

The macro runs fine as it is but running it manually 500 time is a bit
wearsome!

I am not a VB writer so I need to keep it simple.

Thanks again,
Martin

"bpeltzer" wrote in message
...
This snippet is adapted from the VBA help screen for the find method:

With ActiveSheet.Cells
Set c = .Find(2, LookIn:=xlValues) ''substitute your FIND
expression
If Not c Is Nothing Then
firstaddress = c.Address
Do
c.Value = 5 ''change the '5' your
expression(s)
to update the found cell
Set c = .FindNext(c)
If (Not (c Is Nothing)) Then
If c.Address = firstaddress Then c = Nothing
End If
Loop While (Not (c Is Nothing))
End If
End With

BTW, it wasn't clear to me if you want the loop to make the change for
each
match (the code above is intended to help with that) or just for the
final
ocurrance. If the latter, it would be easier just to start with the
last
cell (IV65536) and change the SearchDirection argument in the Find to
xlPrevious)
HTH. --Bruce


"Martin" wrote:

Hello,

I have recorded a Macro which selects a worksheet, does a find on a
word
and
copies the data from another cell over it. I need to make my Macro
Loop
until it finds the last ocurrance of the word.

If I put at the beginning of the macro Do Until, what expression do
I
put
after it?

Do I just put Loop at the end?

This is the macro:



Sheets("Book1").Select
Application.Goto Reference:="R1C1"
Cells.Find(What:="sub", After:=ActiveCell, LookIn:=xlFormulas,
LookAt:=
_
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(-2, 0).Range("A1").Select
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(-2, 6).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, -6).Range("A1:G1").Select
ActiveCell.Activate
Selection.Copy
Sheets("Book1NEW").Select
Application.Goto Reference:="R60000C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 4).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Cut
Destination:=ActiveCell.Offset(0, -3).Range("A1:C1")
ActiveCell.Offset(0, -3).Range("A1:C1").Select
Sheets("Book1").Select
End Sub


Thanks in advance,
Martin