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

How about inserting this in there? Is that what you're asking for?

Range("A1").Select
Dim strProject As String
Dim iRow As Integer
iRow = 0
Do
strProject = Left(ActiveCell.Offset(iRow, 0).Value, 6)
FindProj = InputBox("Enter Project Number, such as 00-000", "Enter
Project Number", strProject)
iRow = iRow + 1
Loop Until iRow = ActiveSheet.UsedRange.Rows.Count


-Ikaabod

GregR Wrote:
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
.
.
.
FindProj = InputBox("Enter Project Number, such as 00-000", "Enter
Project Number", "06-012") <<<<<<<REPLACE THIS WITH PROJECT ARRAY
.
.
.
Greg


--
Ikaabod
------------------------------------------------------------------------
Ikaabod's Profile: http://www.excelforum.com/member.php...o&userid=33371
View this thread: http://www.excelforum.com/showthread...hreadid=541161

Ikaabod, I want to eliminate the InputBox and just loop through the
project range. I believe your code does this, but does it eliminate the
InputBox? TIA

Ikaabod, I also want it to start at Row(7). Would I change iRow = 0 to
iRow = 6? TIA

Yes changing iRow to 6 would do this. The code below just finds the
values for you... I don't know where you want to put these values.

Sub Macro1()
Range("A1").Select
Dim iRow As Integer
iRow = 6
Do
FindProj = Left(ActiveCell.Offset(iRow, 0).Value, 6)
'Enter code here to place this value "FindProj" wherever you want it
'Example: Range("B7").Value = FindProj
iRow = iRow + 1
Loop Until iRow = ActiveSheet.UsedRange.Rows.Count
End Sub

GregR Wrote:
Ikaabod, I also want it to start at Row(7). Would I change iRow = 0 to
iRow = 6? TIA


--
Ikaabod
------------------------------------------------------------------------
Ikaabod's Profile: http://www.excelforum.com/member.php...o&userid=33371
View this thread: http://www.excelforum.com/showthread...hreadid=541161

Ikaabod, I think I am almost there. What I have so far is not quite
working. Here is what I have:

Sub Copy340WIP()
Dim WBwip As Workbook
Dim WB2 As Workbook
Dim Rng As Range
Dim Cel As Range
Dim Sname As String
Const sStr As String = "A2"
Dim frng As Range
Dim iRow As Integer
Dim FindStr As String

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
WB2.Activate
Range("A1").Select
iRow = 6
Do
FindProj = Left(ActiveCell.Offset(iRow, 0).Value, 6)

Set frng = Cells.Find(what:=FindProj, LookIn:=xlFormulas,
lookat:=xlPart)
If Not frng Is Nothing Then
WBwip.Sheets("340-000-900 Pivot Table").Activate
FindStr = frng.Offset(0, 9).Address(1, 1, xlA1)
Else
MsgBox ("Project, not found")
End If
frng.Offset(0, 9).Activate
Selection.ShowDetail = True

ActiveSheet.Move After:=WB2.Worksheets(WB2.Worksheets.Count)
ActiveSheet.Name = Left(Range(sStr), 6)

iRow = iRow + 1
Loop Until iRow = ActiveSheet.UsedRange.Rows.Count

Application.DisplayAlerts = True

End Sub

The desired result would be to loop through the projects starting in A7
of the activebook, lookup that value in WBwip and offset that result by
nine columns, activate that cell, return the displayed results to WB2.
Finish when all project sheets have been added to WB2. WBwip is a pivot
table if this matters. TIA

Which part is not working?
I'm still not quite clear on what it is you need done. It appears tha
your macro is trying to actually move/copy the entire worksheet fro
WBwip into WB2. Is this what you desire? What do you mean by "offse
that result by
nine columns, activate that cell, return the displayed results t
WB2."? Where in WB2 do you want it displayed? and is "it" the valu
in the activecell?

I want to help, and maybe it's just me, but I need more info to wor
with.

GregR Wrote:


The desired result would be to loop through the projects starting i
A7
of the activebook, lookup that value in WBwip and offset that resul
by
nine columns, activate that cell, return the displayed results to WB2.
Finish when all project sheets have been added to WB2. WBwip is
pivot
table if this matters. TI

--
Ikaabo
-----------------------------------------------------------------------
Ikaabod's Profile: http://www.excelforum.com/member.php...fo&userid=3337
View this thread: http://www.excelforum.com/showthread.php?threadid=54116