Sub ReadSheet1, which is roughly shown, reads down column
A in worksheet 1 (no problem), I'm having problems with
the sub ReadSheet2 (shown further down)in which I'd like
to find valueA in Sheet2 and change the color index in
that cell(s).

Any suggestions as to what I'm doing wrong???

Sub ReadSheet1()
Set currentCell = Worksheets(1).Range("A1")
LeeA = currentCell.Offset(0, 0)
Do
counter1 = counter1 + 1

Set nextCell = currentCell.Offset(1, 0)
valueA = currentCell.Offset(0, 0)

ReadSheet2(valueA)

Set currentCell = nextCell
Set nextCell = currentCell.Offset(counter1, 0)
Loop While True
End sub

Sub ReadSheet2(partNum)
Dim Range1 As Object
Set Range1 = Worksheets("Sheet2").Range("A1:A899")

On Error GoTo errorcode
Cells.Find(What:=partNum, After:=ActiveCell,
LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:= _
False).Activate

With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

Exit Sub
errorcode:
If Err = 91 Then
MsgBox ("part doesn't exist:" & Err)
Else
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
MsgBox ("part exists:" & Err)
End If
End Sub

Is this what you're trying to do?

Sub ReadSheet2(partNum)
Dim Range1 As Range, rngFind As Range

Set Range1 = Worksheets("Sheet2").Range("A1:A899")

On Error GoTo errorcode

Set rngFind = Range1.Find(What:=partNum, LookIn:=xlFormulas,
LookAt:=xlWhole)
If Not rngFind Is Nothing Then
With rngFind.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Else
MsgBox ("Part doesn't exist.")
End If

Exit Sub

errorcode:

End Sub

HTH
Paul
--------------------------------------------------------------------------------------------------------------
Be advised to back up your WorkBook before attempting to make changes.
--------------------------------------------------------------------------------------------------------------

Sub ReadSheet1, which is roughly shown, reads down column
A in worksheet 1 (no problem), I'm having problems with
the sub ReadSheet2 (shown further down)in which I'd like
to find valueA in Sheet2 and change the color index in
that cell(s).

Any suggestions as to what I'm doing wrong???

Sub ReadSheet1()
Set currentCell = Worksheets(1).Range("A1")
LeeA = currentCell.Offset(0, 0)
Do
counter1 = counter1 + 1

Set nextCell = currentCell.Offset(1, 0)
valueA = currentCell.Offset(0, 0)

ReadSheet2(valueA)

Set currentCell = nextCell
Set nextCell = currentCell.Offset(counter1, 0)
Loop While True
End sub

Sub ReadSheet2(partNum)
Dim Range1 As Object
Set Range1 = Worksheets("Sheet2").Range("A1:A899")

On Error GoTo errorcode
Cells.Find(What:=partNum, After:=ActiveCell,
LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:= _
False).Activate

With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

Exit Sub
errorcode:
If Err = 91 Then
MsgBox ("part doesn't exist:" & Err)
Else
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
MsgBox ("part exists:" & Err)
End If
End Sub