Find/replace macro

[Guest]

Hi guys,

I have two sheets I am dealing with right now: Data and Table. I am trying
to create a macro to locate a cell content, say Data:A1, finding it in column
B range in Table, and moving four cells to the right of it (adding the
character "y" to it). I've tried to use autofilter and find that way as
well, but that didn't seem to work either.

Here is my script below. Where it says Criteria1:="=510", that should be
the cell contents in Data:A1. Any help that can be offered will be greatly
appreciated.

Sub MyMacro()

Range("C2").Select
Selection.Copy
Sheets("Table").Select
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveWindow.SmallScroll ToRight:=-1
Sheets("Data").Select
Range("C2").Select
Selection.Copy
Sheets("Table").Select
Selection.AutoFilter Field:=2, Criteria1:="=510", Operator:=xlAnd
Range("F8").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "y"
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Century Gothic"
.FontStyle = "Regular"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("F88").Select
Selection.AutoFilter
Sheets("Data").Select
Range("C2").Select
End Sub

 

[Dave Peterson]

How about just using Find?

Option Explicit
Sub testme()

Dim myWord As String
Dim FirstAddress As String
Dim FoundCell As Range

myWord = Worksheets("data").Range("a1").Value

With Worksheets("table").Range("b:b")
Set FoundCell = .Cells.Find(What:=myWord, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
'do nothing--not found
Else
FirstAddress = FoundCell.Address
Do
With FoundCell.Offset(0, 4)
.Value = "y"
With .Font
.Name = "Century Gothic"
.FontStyle = "Regular"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
End With
Set FoundCell = .FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> FirstAddress
End If
End With
End Sub