Find and Replace using a Loop won't stop
 

I am trying to replace cells on certain rows with the value in cell I1 within
column I based on a found row from a cell in column C. I have the following
macro:

ActiveCell.FormulaR1C1 = "='Master'!R3C9"
Selection.Copy

TotalRowsToDo = ActiveCell.CurrentRegion.Rows.Count
Counter = 1

Do Until Counter = TotalRowsToDo
Cells.Find(What:="FB01", After:=ActiveCell, LookIn:=xlFormulas,
LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 6).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Counter = Counter + 1
Loop

The macro doesn't stop when it gets to the bottom of the range, it just
keeps cycling. I have also tried using IsEmpty
(ActiveCell.Offset(1,0).Select) which doesn't work either.

Please help with solution to stop it when it gets to the bottom of the
populated cells.

Thank you!

Find and Replace using a Loop won't stop
 

Hi

This solution exit the loop when 'Find' return to first match found:

Sub test()
Dim fFound As Range
Dim f As Variant
ActiveCell.FormulaR1C1 = "='Master'!R3C9"
ActiveCell.Copy


TotalRowsToDo = ActiveCell.CurrentRegion.Rows.Count
Counter = 1

Set f = Cells.Find(What:="FB01", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If f Is Nothing Then Exit Sub 'No match found

Set fFound = f
Do
f.Offset(0, 6).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Set f = Cells.FindNext(After:=f)
Loop Until f.Address = fFound.Address
End Sub

Regards,
Per

On 26 Apr., 21:30, Valerie wrote:
I am trying to replace cells on certain rows with the value in cell I1 within
column I based on a found row from a cell in column C. *I have the following
macro:

* * ActiveCell.FormulaR1C1 = "='Master'!R3C9"
* * Selection.Copy

* * TotalRowsToDo = ActiveCell.CurrentRegion.Rows.Count
* * Counter = 1

* * Do Until Counter = TotalRowsToDo
* * * * * * Cells.Find(What:="FB01", After:=ActiveCell, LookIn:=xlFormulas,
LookAt _
* * * * * * * * :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
* * * * * * * * False, SearchFormat:=False).Activate
* * * * * * ActiveCell.Offset(0, 6).Select
* * * * * * Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
* * * * * * * * :=False, Transpose:=False
* * * * Counter = Counter + 1
* * Loop

The macro doesn't stop when it gets to the bottom of the range, it just
keeps cycling. *I have also tried using IsEmpty
(ActiveCell.Offset(1,0).Select) which doesn't work either.

Please help with solution to stop it when it gets to the bottom of the
populated cells.

Thank you!

Find and Replace using a Loop won't stop
 

Works like a charm!!! Thank you so much!!

"Per Jessen" wrote:

Hi

This solution exit the loop when 'Find' return to first match found:

Sub test()
Dim fFound As Range
Dim f As Variant
ActiveCell.FormulaR1C1 = "='Master'!R3C9"
ActiveCell.Copy


TotalRowsToDo = ActiveCell.CurrentRegion.Rows.Count
Counter = 1

Set f = Cells.Find(What:="FB01", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If f Is Nothing Then Exit Sub 'No match found

Set fFound = f
Do
f.Offset(0, 6).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Set f = Cells.FindNext(After:=f)
Loop Until f.Address = fFound.Address
End Sub

Regards,
Per

On 26 Apr., 21:30, Valerie wrote:
I am trying to replace cells on certain rows with the value in cell I1 within
column I based on a found row from a cell in column C. I have the following
macro:

ActiveCell.FormulaR1C1 = "='Master'!R3C9"
Selection.Copy

TotalRowsToDo = ActiveCell.CurrentRegion.Rows.Count
Counter = 1

Do Until Counter = TotalRowsToDo
Cells.Find(What:="FB01", After:=ActiveCell, LookIn:=xlFormulas,
LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 6).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Counter = Counter + 1
Loop

The macro doesn't stop when it gets to the bottom of the range, it just
keeps cycling. I have also tried using IsEmpty
(ActiveCell.Offset(1,0).Select) which doesn't work either.

Please help with solution to stop it when it gets to the bottom of the
populated cells.

Thank you!

.