Here are two more versions of the same subroutine. The first does a
case-sensitive search, and both the column to search and the column to which
to write are specified as constants. The second version prompts the user for
everything.

Sub FindText1()
Dim c As Range, ret
Const FindThis = "zebra"
Const WriteThis = "animal"
Const SearchCol = "A"
Const WriteCol = "B"
Range(SearchCol & "1").EntireColumn.Select
For Each c In Selection
   ret = InStr(1, c, FindThis, 0)
   If (Not IsNull(ret)) And (ret > 0) Then
       Range(WriteCol & c.Row).Value = WriteThis
   End If
Next c
End Sub

Sub FindText2()
Dim c As Range, FindThis As String, CaseSens As Integer
Dim WriteThis As String, SearchCol As String
Dim WriteCol As String, ret
FindThis = InputBox("Text to find", "FindText2", "zebra")
If Len(FindThis) = 0 Then Exit Sub
WriteThis = InputBox("Text to write", "FindText2", "animal")
If Len(WriteThis) = 0 Then Exit Sub
SearchCol = InputBox("Search which column?", "FindText2", "A")
If Len(SearchCol) = 0 Then Exit Sub
WriteCol = InputBox("Write to which column?", "FindText2", "B")
If Len(WriteCol) = 0 Then Exit Sub
ret = MsgBox("Case-sensitive?", vbYesNo, "FindText2")
If ret = vbYes Then
   CaseSens = 0
Else
   CaseSens = 1
End If
Range(SearchCol & "1").EntireColumn.Select
For Each c In Selection
   ret = InStr(1, c, FindThis, CaseSens)
   If (Not IsNull(ret)) And (ret > 0) Then
       Range(WriteCol & c.Row).Value = WriteThis
   End If
Next c
End Sub

Hope this helps,

Hutch