From: Valerie on
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!
From: Per Jessen on
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 <Vale...(a)discussions.microsoft.com> 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!

From: Valerie on
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 <Vale...(a)discussions.microsoft.com> 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!
>
> .
>