Find value and replace cell below
 

Hi,

I know how to do find and replace code but this is slightly different.

I want to find a value in a range, and replace the cell below where
the value was found.

Many thanks,

Find value and replace cell below
 

Hi Keri,

Perhaps try something like:

'==========
Public Sub aTester()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim rCell As Range
Dim Res As String
Const sReplacement As String = "ABC" '<<=== CHANGE

Set WB = Workbooks("MyBook.xls") '<<==== CHANGE
Set SH = WB.Sheets("Sheet1") '<<==== CHANGE
Set Rng = SH.Range("A1:A100") '<<==== CHANGE

Res = InputBox(prompt:="insert the text to be found")

If Res = vbNullString Then
Exit Sub
End If

With Rng
Set rCell = .Find(What:=Res, _
After:=.Cells(1), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With

If Not rCell Is Nothing Then
rCell.Offset(1).Value = sReplacement
End If
End Sub
'<<=============


---
Regards,
Norman


"keri" wrote in message
oups.com...
Hi,

I know how to do find and replace code but this is slightly different.

I want to find a value in a range, and replace the cell below where
the value was found.

Many thanks,

Find value and replace cell below
 

Thanks,

I've got something vaguely similar after some searching.

However I now have 2 problems

1. My code only finds the first instance of a value to find in a row -
the loop does not seem to work

2. My code only searches 1 row at a time, (this is linked to the above
problem), when I have selected a larger range (3 rows) it still only
returns the first instance of the value.

Many thanks for your suggestions in advance.

Dim rngFound As Range
Dim rngToSearch As Range
Dim rngcopyto As Range
Dim rngcopyto1 As Range
Dim rngcopyto2 As Range
Dim thesesheets As Worksheet
Dim thissheet As Worksheet
Dim strFirstAddress As String

Set thissheet = Sheets("Sheet1")

'FIND SKY AND VISIBILITY ok
For Each thesesheets In Worksheets
Set rngToSearch =
thesesheets.Range("12:12,15:15,21:21").EntireRow
Set rngFound = rngToSearch.find("CAVOK")
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Do
Set rngcopyto = rngFound.Offset(1, 0)
Set rngcopyto1 = rngFound.Offset(1, 1)
rngcopyto.Value = "SKY AND VISIBILITY OK"
Loop While rngFound.Address < strFirstAddress
End If
Next thesesheets