Help with Loop please

[Martin]

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

[bpeltzer]

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

[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" <bpeltzer@discussions.microsoft.com> wrote in message
news:C2A677E7-31E6-46E3-9E95-6105918E98AE@microsoft.com...
> 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
> >
> >
> >

[bpeltzer]

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" <bpeltzer@discussions.microsoft.com> wrote in message
> news:C2A677E7-31E6-46E3-9E95-6105918E98AE@microsoft.com...
> > 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
> > >
> > >
> > >
>
>
>

[Martin]

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


"bpeltzer" <bpeltzer@discussions.microsoft.com> wrote in message
news:E339CB6A-A108-420A-8554-520FA1460F2E@microsoft.com...
> 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" <bpeltzer@discussions.microsoft.com> wrote in message
> > news:C2A677E7-31E6-46E3-9E95-6105918E98AE@microsoft.com...
> > > 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
> > > >
> > > >
> > > >
> >
> >
> >