I have code with an input box that works as expected .Instead of the
input box I would like to loop through the projects, which are defined
in column "A" of the active sheet starting at Row 5. The projects are
defined by the left (6) characters in "A". The expected result would be
the activeworkbook filled with the detail sheet from each project
listed in "A". Need help. TIA

For example column data:


05-001-000-000-000
06-001-000-000-000 etc.


Projects are 05-001 and 06-001. The code:


Sub Copy340WIP()
Dim WBwip As Workbook
Dim WB2 As Workbook


Set WB2 = ActiveWorkbook


On Error Resume Next
Set WBwip = Workbooks("RF 340-000.xls")
On Error GoTo 0
If WBwip Is Nothing Then
ChDir "S:\FIN\Finance\Capital Projects\WIP Detail"
Workbooks.Open filename:= _
"S:\FIN\Finance\Capital Projects\WIP Detail\RF 340-000.xls"
Else
'already open
End If


WBwip.Sheets("340-000-900 Pivot Table").Activate


Call FindStr("Proj")


Selection.ShowDetail = True


ActiveSheet.Move After:=WB2.Worksheets(WB2.Worksheets.Count)


Application.DisplayAlerts = True


End Sub


Function FindStr(FindProj As String) As String
Dim frng As Range


FindProj = InputBox("Enter Project Number, such as 00-000", "Enter
Project Number", "06-012") <<<<<<<REPLACE THIS WITH PROJECT ARRAY


Set frng = Cells.Find(what:=FindProj, LookIn:=xlFormulas,
lookat:=xlPart)
If Not frng Is Nothing Then
FindStr = frng.Offset(0, 9).Address(1, 1, xlA1)
Else
MsgBox ("Proj, not found")
End If
frng.Offset(0, 9).Activate


End Function


Greg