dmthornton, you da man so far. Here is what I have and it works as
expected.

Sub CheckProjInTwo()
Dim rng1 As Range
Dim rng2 As Range
Dim rng As Range
Dim wkbk As Workbook
Dim wkbk1 As Workbook
Dim wkbk2 As Workbook
Const sStr As String = "A2"
Set wkbk = ActiveWorkbook
Set wkbk1 = Workbooks("RF 340-000.xls")

With wkbk.Worksheets(1)
Set rng1 = .Range(.Cells(7, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
With wkbk1.Worksheets(1)
Set rng2 = .Range(.Cells(7, 1), .Cells(Rows.Count, 1).End(xlUp))
End With

With wkbk.Worksheets(1)

With rng2
Dim rngCell As Range
Set rngCell = .Find( _
what:=ActiveCell, _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
SearchFormat:=False)

End With

If Not IsError(rngCell) Then
wkbk1.Activate
rngCell.Offset(0, 9).Activate
Selection.ShowDetail = True

ActiveSheet.Move After:=wkbk.Worksheets(wkbk.Worksheets.Count)
ActiveSheet.Name = Left(Range(sStr), 6)
Else
MsgBox "Project not in WIP"
End If
End With

End Sub

Now, if you could just help with the loop we (or you) got it. TIA

Greg