Loop thru Range Help needed

[GregR]

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

[Ikaabod]

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

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

[GregR]

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

[GregR]

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

[Ikaabod]

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

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

[GregR]

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

[Ikaabod]

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

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

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

[GregR]

Ikaabod, WB2 is a workbook that has projects listed in Column A. The
project identifier is actually the left(6) characters. WBwip is a pivot
table that has those same projects listed with total expenditure amount
listed in Column (J). What I want is to match the project in WB2 with
WBwip in Column A, then offset that found cell to Column (J), the
expenditure column and display the detail of that expenditure, which
actually adds a sheet to WBwip. Then move that detail sheet to WB2. As
an example WB2 identifies A7=06-013, the result 06-013 is used to
lookup the project in WBwip. Once it finds the matching 06-013, it
offsets to the total expenditure column and displays the detailed
results of that expenditure and moves that detail sheet to WB2. Once it
does that, it loops through the rest of projects in WB2 and does that
until all projects have been added to WB2. The finished result is WB2
has the initial project sheet with additional detailed expenditure
sheets for each project.

When I did with it with the input box, everything worked perfectly, but
if I had 10 projects I had to run the macro 10 times. I just want to
eliminate the input box and loop through the projects to achieve the
same results. HTH

Greg

[Ikaabod]

When I run your script with the input box it moves the WBwip worksheet "340-000-900 Pivot Table" completely out of WBwip and puts it into WB2. The script would not be able to loop since you set it up to search for "340-000-900 Pivot Table" in WBwip which, after the first run through, is no longer there b/c it now resides in WB2. The only thing I'm seeing happen (beyond it offsetting the activecell and then doing nothing with this information that I noticed) is that it moves the worksheet.

When I did with it with the input box, everything worked perfectly, but
if I had 10 projects I had to run the macro 10 times. I just want to
eliminate the input box and loop through the projects to achieve the
same results.

[GregR]

Ikaabod, here is my progress so far and it works as expected. The only
part I need to add now is the looping of the projects in
WB2. You can see, I have commented out a couple of lines that didn't
work. TIA

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)
'For Each c In rng1.Cells

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

'Next

End Sub

Greg