I need to stop this Loop

[DaveM]

Hi all

This works but I have to press Esc key to stop the macro. I've been reading
up on loops but need more time to work with them.

Sub ChangeNames()

Sheets("Sheet2").Select
Application.Goto Reference:="R2C5"

Do
Cells.Find(What:="Test1", After:=ActiveCell, LookIn:=xlValues, LookAt:=
_
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate

Sheets("Tests htmls").Select
Application.Goto Reference:="R1C1"
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Loop Until IsEmpty(ActiveCell.Offset(0, 0))

End Sub

I also have items in A2 to A37 "Tests htmls" I'd like to change in sheet2
col E, is there a way to do this all in one macro, rather than have 37
macros.

Thanks in advace

Dave

 

[PCLIVE]

What is the purpose of Looping in this code. The Loop will only end if A1
or R1C1 of sheet "Tests htmls" is empty. If it wasn't empty the first time
through, then it won't be empty the second time or any other time unless you
empty it yourself. Therefore, the Loop will never end.

Additionally, in the last line, the "Offset" is unnecessary since you are
not offsetting anything.

Replace - Loop Until IsEmpty(ActiveCell.Offset(0, 0))
With - Loop Until IsEmpty(ActiveCell)

HTH,
Paul

 

[Tom Ogilvy]

Sub ChangeNames()
Dim rng As Range
Dim sAddr As String
With Sheets("Sheet2").Cells
Set rng = .Find(What:="Test1", _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rng Is Nothing Then
sAddr = rng.Address
Do
rng.Value = Sheets("Tests htmls").Range("A1")
Set rng = .FindNext(rng)
Loop Until rng Is Nothing
End If
End With
End Sub

You would need a list of what values are replaced with what. Perhaps you
could put this in Tests htmls in column B next to your values in column A.

So A1:A37 contain the values to use as replacements
B1:B37 contain the values that will be replaced.

Since your using xlPart, make sure you don't have any situations where one
value is a substring of another value.

Sub ChangeAllNames()
Dim cell As Range, rng As Range
Dim sAddr As String
For Each cell In Worksheets( _
"Tests htmls").Range("A1:A37")
Debug.Print cell, cell.Offset(0, 1)
With Sheets("Sheet2").Cells
Set rng = .Find( _
What:=cell.Offset(0, 1).Value, _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rng Is Nothing Then
Debug.Print "--" & rng.Address
sAddr = rng.Address
Do
rng.Value = cell
Set rng = .FindNext(rng)
Loop Until rng Is Nothing
End If
End With
Next cell
End Sub

 

[DaveM]

Thanks for your help

Sub ChangeNames()
Dim rng As Range
Dim sAddr As String
With Sheets("Sheet2").Cells
Set rng = .Find(What:="Test1", _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rng Is Nothing Then
sAddr = rng.Address
Do
rng.Value = Sheets("Tests htmls").Range("A1")
Set rng = .FindNext(rng)
Loop Until rng Is Nothing
End If
End With
End Sub

You would need a list of what values are replaced with what. Perhaps you
could put this in Tests htmls in column B next to your values in column A.

So A1:A37 contain the values to use as replacements
B1:B37 contain the values that will be replaced.

Since your using xlPart, make sure you don't have any situations where one
value is a substring of another value.

Sub ChangeAllNames()
Dim cell As Range, rng As Range
Dim sAddr As String
For Each cell In Worksheets( _
"Tests htmls").Range("A1:A37")
Debug.Print cell, cell.Offset(0, 1)
With Sheets("Sheet2").Cells
Set rng = .Find( _
What:=cell.Offset(0, 1).Value, _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rng Is Nothing Then
Debug.Print "--" & rng.Address
sAddr = rng.Address
Do
rng.Value = cell
Set rng = .FindNext(rng)
Loop Until rng Is Nothing
End If
End With
Next cell
End Sub