Find and replace in a different cell macro

Question

I need a macro to find the value within a range, then input another value in the cell directly below it. Here's what I have so far:

Sub Macro1() Dim Find, Replace As Variant

   Find = InputBox("Enter Text To Be Replaced", " Find And Replace")
   Replace = InputBox("Enter Replacement Text", "Find And Replace")
   
   Cells.Replace What:=Find, Replacement:=Replace,  LookAt:=xlPart, _
   SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
   ReplaceFormat:=False

End Sub

Answer

Tiff,

Your code uses the built in Replace function - but that replaces what you found. Here is code that should do what you want. (tested and worked fine for me on the active worksheet)

Sub GetData() Dim sh As Worksheet Dim sAddr As String, s As Variant Dim rng As Range, rr As Range Dim sFind As String, sReplace As String

sFind = InputBox("Enter Text To Be Replaced", " Find And Replace") If Len(Trim(sFind)) = 0 Then

  MsgBox "No target string provided; no replace will be performed"
  Exit Sub

End If sReplace = InputBox("Enter Replacement Text", "Find And Replace") Set sh = ActiveSheet Set rr = sh.Cells ' you can change to a specific range such as

                    ' Set rr = sh.Range("A1:F50")
                    ' if you only wanted to work in that range

Set rr = sh.Range("A1:F50") Set rr = rr.Cells Set rng = rr.Find(What:=sFind, _

After:=rr(1), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rng Is Nothing Then

 sAddr = rng.Address
 Do
    If rng.Row <> sh.Rows.Count Then
      rng.Offset(1, 0).Value = sReplace
    End If
 Set rng = rr.FindNext(rng)
 Loop Until rng.Address = sAddr

End If End Sub