Find/Replace Macro

[sparky2205]

This one is a little odd. I created a Find/Replace macro to use when worksheets are protected.
It works fine in terms of doing all the replacements.
I also have a messagebox at the end which tells the user how many replacements they have made and in which cells.
This is where it gets interesting. To create the issue exactly do the following:
On a spreadsheet with the macro installed make exactly the following entry in one cell:

Tests Results

Run the macro and replace Tests with Test when prompted. The message that presents says "0 replacements made at cells:". But the replacement has been made.
Stepping into the code I can see that if I hover over my range c it says "Object variable or With block variable not set". So iCountReplace never gets populated, which is why my message doesn't display correctly.

Now reverse that and replace Test With Tests. All replacements made and the message displays correctly.
Now replace Tests with Exam. All replacements made and the message displays correctly.

I also tried replacing Joes in Joes Results with Joe. This also produces the error.
But if I replace Joes in Joes Results with Tom (i.e. Tom Results) it works fine.
And when I replace Toms in Toms Results with Tom (i.e. Tom Results) I get the error.
The error appears to happen when I try to replace a word with a word that is similar but shorter than the original word. e.g. Replacing Toms with Tom or To produces the error.

Here is the code: (apologies but the code tags always strip my indents)

Sub Find_Replace()

Dim c As Range
Dim r As Range
Dim sFind As String
Dim sReplace As String
Dim sChangedCell As String
Dim sChangedCells As String
Dim iCountCells As Integer
Dim iCountReplace As Integer
Dim iCountExist As Integer
Set r = ActiveSheet.UsedRange
Dim pw As String

Application.ScreenUpdating = False

pw = ""

iCountCells = 0
iCountReplace = 0
iCountExist = 0

'The term to be replaced
sFind = Application.InputBox("Find what?", , , , , , 2)
'If the user doesn't make an entry
If sFind = "" Or sFind = "False" Then Exit Sub

    'Check if the term being searched for exists in the document
For Each c In r
If InStr(c.Value, sFind) <> 0 Then
iCountCells = iCountCells + 1
End If
Next c

'If the term being searched for doesn't exist in the document inform the user
If iCountCells = 0 Then
MsgBox "Search item not found"
Exit Sub
    End If

'The term to replace with
sReplace = Application.InputBox("Replace with what?", , , , , , 2)
'If the user doesn't make an entry
If sReplace = "" Or sReplace = "False" Then Exit Sub

'Unprotect the worksheet
ActiveSheet.Unprotect Password:=pw

'For each cell in the used range
For Each c In r
'If it isn't locked
If c.Locked = "False" Then
'Select the cell
c.Activate
'If the cell already contains the new text
If InStr(c.Value, sReplace) <> 0 Then
iCountExist = iCountExist + 1
End If
'Replace the Find text with the new text
c.Replace sFind, sReplace, xlPart, xlByRows, False, False, False, False
'Count the number of replacements
If InStr(c.Value, sReplace) <> 0 Then
If iCountExist = 0 Then
iCountReplace = iCountReplace + 1
sChangedCell = c.Address
sChangedCells = sChangedCells & vbCrLf & sChangedCell
Else: iCountReplace = iCountReplace
End If
End If
End If
iCountExist = 0
sChangedCell = ""
Next c

Application.ScreenUpdating = True

'Inform the user of the number of replacements made
If iCountReplace = 1 Then
MsgBox iCountReplace & " replacement made at cell:" & sChangedCells
Else: MsgBox iCountReplace & " replacements made at cells:" & sChangedCells
    End If

'Reprotect the worksheet
ActiveSheet.Protect Password:=pw, _
AllowFormattingCells:="true", _
AllowFormattingRows:="true", _
AllowFormattingColumns:="true", _
AllowInsertingRows:="true", _
AllowFiltering:="true"

End Sub
[/ICODE]

 

[DanteAmor]

In this case the correct syntax for the Instr function is:
If InStr(1, c.Value, sFind, vbTextCompare) <> 0 Then

I made some changes to the code, try and tell me.

Sub Find_Replace()
  Dim c As Range, r As Range, iCountReplace As Long
  Dim sFind As String, sReplace As String, sChangedCells As String, pw As String
  
  Application.ScreenUpdating = False
  Set r = ActiveSheet.UsedRange
  pw = ""
  
  'The term to be replaced
  sFind = Application.InputBox("Find what?", , , , , , 2)
  'If the user doesn't make an entry
  If sFind = "" Or sFind = "False" Then Exit Sub
  
  'Check if the term being searched for exists in the document
  Set c = r.Find(sFind, , xlValues, xlPart, , , False)
  If c Is Nothing Then
    MsgBox "Search item not found"
    Exit Sub
  End If
  
  'The term to replace with
  sReplace = Application.InputBox("Replace with what?", , , , , , 2)
  'If the user doesn't make an entry
  If sReplace = "" Or sReplace = "False" Then Exit Sub
  
  'Unprotect the worksheet
  ActiveSheet.Unprotect Password:=pw
  
  'For each cell in the used range
  For Each c In r.SpecialCells(xlCellTypeConstants)
    'If it isn't locked
    If c.Locked = False Then
      If InStr(1, c.Value, sFind, vbTextCompare) <> 0 Then
        'Replace the Find text with the new text
        c.Replace sFind, sReplace, xlPart, xlByRows, False, False, False, False
        iCountReplace = iCountReplace + 1
        sChangedCells = sChangedCells & vbCrLf & c.Address
      End If
    End If
  Next c
  
  Application.ScreenUpdating = True
  
  'Inform the user of the number of replacements made
  If iCountReplace = 1 Then
    MsgBox iCountReplace & " replacement made at cell:" & sChangedCells
  Else
    MsgBox iCountReplace & " replacements made at cells:" & sChangedCells
  End If
  
  'Reprotect the worksheet
  ActiveSheet.Protect Password:=pw, AllowFormattingCells:="true", AllowFormattingRows:="true", _
    AllowFormattingColumns:="true", AllowInsertingRows:="true", AllowFiltering:="true"
End Sub

 

[sparky2205]

Thanks Dante, that works very well. And it's neater code.
I've also figured out why my code is not working now.
I have this little piece to exclude like for like replacements being reported as replacements to the user:

'If the cell already contains the new text
        If InStr(c.Value, sReplace) <> 0 Then
            iCountExist = iCountExist + 1
        End If

This works fine except where the existing text is a subset of the replacement text.
In that case my iCountExist variable will never = 0 and my iCountReplace variable will always = 0 which will generate that empty message to the user.

But I can fix that now so thank you for your help.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.