Find and Replace based on Selection only

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

Code:

---

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

---

Code:

---

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:

Code:

---

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

---

Quote:

---

Originally Posted by p45cal

Code:

---

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:

Code:

---

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.

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