PDA

View Full Version : [SOLVED] Find and Replace based on Selection only



jimroa
04-24-2019, 03:31 AM
Trying to modify this code to select a range and then have find & replace. Since the words may appear in other areas of the worksheet I only want the selected range.
ie. the attached sheet - If I select G:G in the Input Box, B:B will not change



Sub FindReplaceAll()

Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
Dim x As Long
Dim rng As Range


Set rng = Application.InputBox(Prompt:="Please select the range with the mouse", Title:="Selection required", Type:=8)


fndList = Array("Unsubstantiated", "Substantiated", "Insufficient information to substantiate")
rplcList = Array("Invalid", "Valid", "Insufficient")


rng.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False




End Sub

p45cal
04-24-2019, 04:16 AM
Sub FindReplaceAll()
Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
Dim x As Long
Dim rng As Range

Set rng = Application.InputBox(Prompt:="Please select the range with the mouse", Title:="Selection required", Type:=8)
answ = 1
If rng.Cells.Count = 1 Then answ = MsgBox("Only one cell selected so this will affect the whole worksheet" & vbLf & "Contine?", vbOKCancel, "")
If answ = 1 Then

fndList = Array("Unsubstantiated", "Substantiated", "Insufficient information to substantiate")
rplcList = Array("Invalid", "Valid", "Insufficient")
For x = LBound(fndList) To UBound(fndList)
rng.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next x
End If
End Sub


Edit after posting:
After doing some testing, the message about only one cell is not necessary on my version of Excel (Office 365) - it used to be. So depending on what version of Excel you have the code could be shortened:

Sub FindReplaceAll()
Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
Dim x As Long
Dim rng As Range

Set rng = Application.InputBox(Prompt:="Please select the range with the mouse", Title:="Selection required", Type:=8)
fndList = Array("Unsubstantiated", "Substantiated", "Insufficient information to substantiate")
rplcList = Array("Invalid", "Valid", "Insufficient")
For x = LBound(fndList) To UBound(fndList)
rng.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next x
End If
End Sub

jimroa
04-24-2019, 07:49 AM
Sub FindReplaceAll()
Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
Dim x As Long
Dim rng As Range

Set rng = Application.InputBox(Prompt:="Please select the range with the mouse", Title:="Selection required", Type:=8)
answ = 1
If rng.Cells.Count = 1 Then answ = MsgBox("Only one cell selected so this will affect the whole worksheet" & vbLf & "Contine?", vbOKCancel, "")
If answ = 1 Then

fndList = Array("Unsubstantiated", "Substantiated", "Insufficient information to substantiate")
rplcList = Array("Invalid", "Valid", "Insufficient")
For x = LBound(fndList) To UBound(fndList)
rng.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next x
End If
End Sub


Edit after posting:
After doing some testing, the message about only one cell is not necessary on my version of Excel (Office 365) - it used to be. So depending on what version of Excel you have the code could be shortened:

Sub FindReplaceAll()
Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
Dim x As Long
Dim rng As Range

Set rng = Application.InputBox(Prompt:="Please select the range with the mouse", Title:="Selection required", Type:=8)
fndList = Array("Unsubstantiated", "Substantiated", "Insufficient information to substantiate")
rplcList = Array("Invalid", "Valid", "Insufficient")
For x = LBound(fndList) To UBound(fndList)
rng.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next x
End If
End Sub

This is fantastic - as my first post on this forum I am very pleased with the speed, alternate ideas or solutions given.

jimroa
04-24-2019, 07:51 AM
P45Cal - Fantastic! I really appreciate the added version - above and beyond the call! - Since I have to deal with clients still using 2003 and up, I'll keep with your first version but keep the second in reserve.
Again Thanks!
Jim