Exit from a "Find" infinite loop - excel

Question

I have created a Do Loop with Find to replace "Hello" with "Hi" inside column A of Sheet1, but only if the string "XYZ" is not in the same row of column B.
When Find does not replace "Hello", because in column B there is "XYZ", we enter an infinite loop since FindNext always finds "Hello" in column 1
It is possible to avoid infinite loop without making Loop While very complicated?
Please see this image of columns in sheet1
Sub CallMask()
Call Masks("Hello", "XYZ")
End Sub
Sub Masks(sMask_I As String, sNoReplace_I As String)
With Sheets("Sheet1").Columns(1)
Dim CellToReplace As Range
Set CellToReplace = .Find(What:=sMask_I, LookIn:=xlValues, _
SearchDirection:=xlNext, MatchCase:=True, Lookat:=xlPart)
If Not CellToReplace Is Nothing Then
Dim InitialAddress As String
InitialAddress = CellToReplace.Address
Dim MaskRow As Long
Dim Mask As String
On Error Resume Next
Do
MaskRow = WorksheetFunction.Match(sMask_I, _
Sheets("Sheet1").Range("C1:C" & Rows.Count), 0)
Mask = Sheets("Sheet1").Range("D" & MaskRow).Value2
If Sheets("Sheet1").Cells(CellToReplace.Row, 2) <> sNoReplace_I Then
CellToReplace.Value2 = Replace(CellToReplace.Value2, sMask_I, Mask)
End If
Set CellToReplace = .FindNext(CellToReplace)
Loop While Not CellToReplace Is Nothing And CellToReplace.Address _
<> InitialAddress
On Error GoTo 0
End If
End With
End Sub

Answer 1

You could try this:
Option Explicit
Sub CallMask()
Call Masks("Hello", "XYZ", "Hi")
End Sub
Sub Masks(sMask_I As String, sNoReplace_I As String, Replacement As String)
Dim C As Range
With ThisWorkbook.Sheets("Sheet1")
For Each C In .Range("A1", "A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
If C Like "*" & sMask_I & "*" And C.Offset(0, 1) <> sNoReplace_I Then
C.Replace sMask_I, Replacement
End If
Next C
End With
End Sub

Answer 2

When using Find() in a loop it's typically easier to abstract that out into a separate method:
Sub CallMask()
Masks "Hello", "XYZ"
End Sub
Sub Masks(sMask_I As String, sNoReplace_I As String)
Dim matches As Collection, c
Set matches = FindAll(Sheets("Sheet1").Columns(1), sMask_I)
For Each c In matches
If c.Offset(0, 1) <> sNoReplace_I Then
c.Value = Replace(c.Value, sMask_I, c.Offset(0, 3).Value)
End If
Next c
End Sub
'return all matches as a collection
Public Function FindAll(rng As Range, val As String) As Collection
Dim rv As New Collection, f As Range
Dim addr As String
Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not f Is Nothing Then addr = f.Address()
Do Until f Is Nothing
rv.Add f
Set f = rng.FindNext(after:=f)
If f.Address() = addr Then Exit Do
Loop
Set FindAll = rv
End Function

Answer 3

I have tested with arrays as suggested by Damian, AJD and Mathieu. It is the fastest code.
Times for 1600 rows are:
My new code with arrays: 8 ms
Damian code with For Next: 132 ms
The Code with "separate method" of Tim Williams: 402 ms
My first code with Find: 511 ms
This is the new code:
Sub CallMask()
Call Masks("Hello", "XYZ")
End Sub
Sub Masks(ByVal sMask_I As String, ByVal sNoReplace_I As String)
With ThisWorkbook.Sheets("Sheet1")
Dim ArrayRangeToMask As Variant
ArrayRangeToMask = .Range("A1:B" & .Cells(.Rows.Count, 2).End(xlUp).Row)
Dim MaskRow As Long
Dim Mask As String
MaskRow = WorksheetFunction.Match(sMask_I, .Range("C1:C" & Rows.Count), 0)
Mask = .Range("D" & MaskRow).Value2
Dim RowMasking As Long
For RowMasking = 1 To UBound(ArrayRangeToMask)
If InStr(ArrayRangeToMask(RowMasking, 1), sMask_I) And _
ArrayRangeToMask(RowMasking, 2) <> sNoReplace_I Then
ArrayRangeToMask(RowMasking, 1) = _
Replace(ArrayRangeToMask(RowMasking, 1), sMask_I, Mask)
End If
Next RowMasking
.Range("A1:B" & .Cells(.Rows.Count, 2).End(xlUp).Row) = ArrayRangeToMask
End With
End Sub