Hi all,
I need to somehow enable the find & replace function within my workbook without giving clients the password for my protected sheet. Within each sheet, there will be a few hundred unlocked cells, so I want them to be able to do a find & replace in there but not within the locked cells. So if they select locked AND unlocked cells, it should only do the find & replace within the unlocked range.
I currently use below module to do just that. Though, the find & replace window is very generic and a lot worse than the built in one. e.g. it does not tell you how many replacements were made, nor can you undo things (not sure that's feasible with vba). Is there a way to more closely replicate the actual find & replace function?
Sub FindReplaceWindow()
Application.ScreenUpdating = False
Dim fStr As String
Dim tStr As String
Dim myRng As Range
Dim myUnlockedCells As Range
Dim myCell As Range
Dim wks As Worksheet
Dim myPWD As String
myPWD = "hi"
Set wks = ActiveSheet
With wks
If .ProtectContents _
Or .ProtectDrawingObjects _
Or .ProtectScenarios Then
'keep going
Else
MsgBox "Sheet is unprotected - just use Edit|Replace!"
Exit Sub
End If
Set myRng = Nothing
On Error Resume Next
Set myRng = Intersect(Selection, .UsedRange)
On Error GoTo 0
If myRng Is Nothing Then
MsgBox "Please select cells in the used range"
Exit Sub
End If
For Each myCell In myRng.Cells
If myCell.Locked = False Then
If myUnlockedCells Is Nothing Then
Set myUnlockedCells = myCell
Else
Set myUnlockedCells = Union(myUnlockedCells, myCell)
End If
End If
Next myCell
If myUnlockedCells Is Nothing Then
MsgBox "No unlocked cells in the selected range"
Exit Sub
End If
fStr = InputBox(Prompt:="Change what")
If Trim(fStr) = "" Then
Exit Sub
End If
tStr = InputBox(Prompt:="To what")
If Trim(tStr) = "" Then
Exit Sub
End If
'unlock sheet'
ActiveSheet.Unprotect Password:="password"
If myUnlockedCells.Cells.Count = 1 Then
Set myUnlockedCells _
= Union(myUnlockedCells, _
.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 1))
End If
On Error Resume Next
myUnlockedCells.Cells.Replace What:=fStr, _
Replacement:=tStr, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
If Err.Number <> 0 Then
MsgBox "An error occurred during the mass change!"
Err.Clear
End If
On Error GoTo 0
'relock sheet'
ActiveSheet.Protect Password:="password"
End With
End Sub
Bookmarks