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 in column A 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
match 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 expected finished result
is WB2
has the initial project sheet with additional detailed expenditure
sheets for each project. Any help would be appreciated. TIA

Greg

I am close with a few minor details. Here is what I have so far:
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
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)
res = Application.Match(ActiveCell, rng2, 0)

If Not IsError(res) Then
wkbk1.Activate
ActiveCell.Offset(0, 9).Activate '<<<<<<activeCell here expected to
be the "res" address in Rng2
Else
MsgBox "Project not in WIP"
End If
End With

End Sub
I expected the "res" to be the active cell, but it isn't. If someone
can help with that problem and add a loop for all projects wkbk.rng1,
I'll have it. TIA

Greg

I don't use the match excel function much from vba, but I don't think it
returns a range, but instead the position within an array (ex. if the value
was found in the 5th row of the lookup array J2:J9, it would return a 5).

If you want the range, I'm confident something like this would work:

Replace the line:
res = Application.Match(ActiveCell, rng2, 0)

With this:
With rng2
Dim rngCell As Range
Set rngCell = .Find( _
What:=ActiveCell, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
SearchFormat:=False _
)
End With

Then replace:
ActiveCell.Offset(0, 9).Activate

With this:
rngCell.Offset(0, 9).Select


Of course, you will have to add/change your error checking.



"GregR" wrote:

I am close with a few minor details. Here is what I have so far:
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
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)
res = Application.Match(ActiveCell, rng2, 0)

If Not IsError(res) Then
wkbk1.Activate
ActiveCell.Offset(0, 9).Activate '<<<<<<activeCell here expected to
be the "res" address in Rng2
Else
MsgBox "Project not in WIP"
End If
End With

End Sub
I expected the "res" to be the active cell, but it isn't. If someone
can help with that problem and add a loop for all projects wkbk.rng1,
I'll have it. TIA

Greg

As far as the looping goes, you could use a for each statement using rng1.cells

Example using your existing code:

For Each c in rng1.Cells
With wkbk.Worksheets(1)
res = Application.Match(c, rng2, 0)

If Not IsError(res) Then
wkbk1.Activate
ActiveCell.Offset(0, 9).Activate
Else
MsgBox "Project not in WIP"
End If
End With

Next

"GregR" wrote:

I am close with a few minor details. Here is what I have so far:
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
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)
res = Application.Match(ActiveCell, rng2, 0)

If Not IsError(res) Then
wkbk1.Activate
ActiveCell.Offset(0, 9).Activate '<<<<<<activeCell here expected to
be the "res" address in Rng2
Else
MsgBox "Project not in WIP"
End If
End With

End Sub
I expected the "res" to be the active cell, but it isn't. If someone
can help with that problem and add a loop for all projects wkbk.rng1,
I'll have it. TIA

Greg

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

Try this code. I basically put the section that finds the match and the
section that selects/copies the details into a For Each loop. So for EACH
CELL in rng1, it will try to find the match in rng2 and create the sheets.
You may have to take out the message box and maybe replace it with a string
that keeps track of all the projects not in wip and then have a message box
after the loop.

I didn't test this code out, so you may have to play with it a little.



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

For Each rngProject In rng1.Cells
With rng2
Dim rngCell As Range
Set rngCell = .Find( _
what:=rngProject.Value, _
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
Next
End Sub

"GregR" wrote:

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

dmthornton, I am getting an error "Variable not set" on the line marked
error

Sub ReturnDetailLoop()
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 = ThisWorkbook
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

For Each rngProject In rng1.Cells
With rng2
Dim rngCell As Range
Set rngCell = .Find( _
what:=rngProject.Value, _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
SearchFormat:=False)
End With

If Not IsError(rngCell) Then
wkbk1.Activate
rngCell.Offset(0, 9).Activate <<<ERROR
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
Next
End Sub

Greg

I might need more info from you to get this right, but I'll take a shot at it:

Workbooks:
WB2 - project summary workbook
WBwip - details of expenditures

Routines:
BuildReport - the main routine (loops through a range of projects)
GetExpenditure- finds the details and copies to WB2

Flow:
The BuildReport routine will loop through a range of cells (set to A1-A10)
and, using the GetExpenditure routine, look at the WBwip book for the
matching project and expenditure sheet and copy that sheet to WB2.
I had to assume some things about how you would want this to work (like
the WBwip book already being opened and that col J has the name of the detail
sheet), so I could be wrong about the approach.

Hopefully this will help a little though:

Sub BuildReport()
'Not quite sure what type of range your looking at
'named range? the whole column?, specific cell range?
'I used a specific cell range (only the ones with values)
For Each c In Range("A1", "A10").SpecialCells(xlCellTypeConstants)
GetExpenditure Left(c.Value, 6)
Next
Worksheets("WB2").Select
End Sub

Sub GetExpenditure(strProject As String)
Dim lngRow As Long

lngRow = -1
With Workbooks("WBwip.xls").Worksheets("WBwip").Columns (1)
On Error Resume Next
'Find the project row based on column A
lngRow = .Find( _
What:=strProject, _
After:=.Range("A1"), _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
SearchFormat:=False _
).Row - 1
On Error GoTo 0

'Process only if it found the project
If lngRow < -1 Then
Dim strExpenditure As String
strExpenditure = .Range("J1").Offset(lngRow, 0)
'Copy to WB2
With Workbooks("WBwip.xls").Worksheets(strExpenditure)
.Copy
After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)
End With
End If
End With
End Sub



"GregR" wrote:

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 in column A 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
match 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 expected finished result
is WB2
has the initial project sheet with additional detailed expenditure
sheets for each project. Any help would be appreciated. TIA

Greg

dmthornton, I think you are close. WBwip sheet is a pivot table and if
for instance the project book has 5 projects in ColA, I want to match
the project to the same project found in WBwip colA. So now, lets say
the project was found at A2000, A2000 is the activecell and that cell
is offset to J2000, which has the total expenditures for the project in
the pivot table. With the statement showdetails, it automatically adds
a sheet to the wbwip book with all the expenditure details. That sheet
is then moved to the projects book. Then loop through the other
projects in the project book to get all detail sheets into the project
book. The routine described above omits the expansion of the details
sheet and the moving to projects book. I think I can get that part. Its
the matching of the project and getting the active cell to be the, in
the above example "J2000". HTH

Greg

I think you answer to matching the right cell is to either use "Find" or a
"For Each".

Example using WBwip ColA

Worksheet("WBwip").Columns(1).Find(What:=Activecel l...

or

For each c in Worksheet("WBwip").Columns(1).SpecialCells(xlCellT ypeConstants)
If c = Activecell Then
c.Select
Exit For
End If
Next

"GregR" wrote:

dmthornton, I think you are close. WBwip sheet is a pivot table and if
for instance the project book has 5 projects in ColA, I want to match
the project to the same project found in WBwip colA. So now, lets say
the project was found at A2000, A2000 is the activecell and that cell
is offset to J2000, which has the total expenditures for the project in
the pivot table. With the statement showdetails, it automatically adds
a sheet to the wbwip book with all the expenditure details. That sheet
is then moved to the projects book. Then loop through the other
projects in the project book to get all detail sheets into the project
book. The routine described above omits the expansion of the details
sheet and the moving to projects book. I think I can get that part. Its
the matching of the project and getting the active cell to be the, in
the above example "J2000". HTH

Greg