RobertN
New Member
- Joined
- Jan 10, 2020
- Messages
- 27
- Office Version
- 365
- Platform
- Windows
- Web
I have been using the code below to find & replace text in multiple excel workbooks, but would like to add inputs to specify sheet name and cell range. I am super novice and have tried playing with the code but have had no luck.
Sub ReplaceInFolder()
Dim strPath As String
Dim strFile As String
Dim wbk As Workbook
Dim wsh As Worksheet
Dim strFind As String
Dim strReplace As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.StatusBar = False
strFind = InputBox("Enter text to find")
If strFind = "" Then
MsgBox "No matching text found!", vbExclamation
Exit Sub
End If
strReplace = InputBox("Enter replacement text")
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
strPath = .SelectedItems(1)
Else
MsgBox "No folder selected!", vbExclamation
Exit Sub
End If
End With
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Application.ScreenUpdating = False
strFile = Dir(strPath & "*.xls*")
Do While strFile <> ""
Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
For Each wsh In wbk.Worksheets
wsh.Cells.Replace What:=strFind, Replacement:=strReplace, _
LookAt:=xlWhole, MatchCase:=False
Next wsh
wbk.Close SaveChanges:=True
strFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Find & Replace Complete"
End Sub
Sub ReplaceInFolder()
Dim strPath As String
Dim strFile As String
Dim wbk As Workbook
Dim wsh As Worksheet
Dim strFind As String
Dim strReplace As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.StatusBar = False
strFind = InputBox("Enter text to find")
If strFind = "" Then
MsgBox "No matching text found!", vbExclamation
Exit Sub
End If
strReplace = InputBox("Enter replacement text")
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
strPath = .SelectedItems(1)
Else
MsgBox "No folder selected!", vbExclamation
Exit Sub
End If
End With
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Application.ScreenUpdating = False
strFile = Dir(strPath & "*.xls*")
Do While strFile <> ""
Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
For Each wsh In wbk.Worksheets
wsh.Cells.Replace What:=strFind, Replacement:=strReplace, _
LookAt:=xlWhole, MatchCase:=False
Next wsh
wbk.Close SaveChanges:=True
strFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Find & Replace Complete"
End Sub