Find Match in another WB and return detailed sheet

[GregR]

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

[GregR]

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]

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.Worksheets.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 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
>
>

[GregR]

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

[dmthornton]

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]

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:=Activecell...

or

For each c in Worksheet("WBwip").Columns(1).SpecialCells(xlCellTypeConstants)
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
>
>

[GregR]

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]

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
>
>

[GregR]

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

[dmthornton]

I hope you found this already, since I was not able to check until now.

If not, it's probably because the "find" function did not find any matches
and therefore rngCell is set to nothing.

You should change:
If Not IsError(rngCell) Then

to:
If Not rngCell is Nothing Then

This will check to see if the variable (rngCell) is set or not.



"GregR" wrote:

> 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
>
>

[GregR]

dmthornton, rngCell is set with the change above, but it won't activate
in wkbk1. I verified that there is a project in wkbk1 that matches
rngCell, but the found project cell is not activating. I still get an
error on the same line. Thanks for sticking with me and sorry for all
the trouble.

Greg

[GregR]

dmthornton, got it to work. Now how do I get the loop to stop once it
has gone through the the Range once. TIA

Greg

[dmthornton]

Hi Greg,

The for each statement loops based on the cells in the range you defined
(rng1). It should loop once for each cell in that range. Is there another
loop somewhere else in the code (not in this subroutine)? Or could a project
be listed more than 1 time within the range?

Also, I noticed in the code that the same worksheet and cell range is
referenced for rng1 and rng2. Maybe this could be an issue.


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


Dave



"GregR" wrote:

> dmthornton, got it to work. Now how do I get the loop to stop once it
> has gone through the the Range once. TIA
>
> Greg
>
>

[GregR]

Dave, got it all working. Here it is with all your help

Sub ReturnDetailLoop()
Const sStr As String = "A2"
Dim rng1 As Range
Dim rng2 As Range
Dim rng As Range
Dim WBPrj As Workbook
Dim WBwip As Workbook
Dim WBPrj2 As Workbook

Set WBPrj = ThisWorkbook

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"
Set WBwip = Workbooks("RF 340-000.xls")
Else
'already open
End If

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

For Each rngproject In rng1.Cells

If rngproject Is Nothing Then
Exit For
End If

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

If Not rngCell Is Nothing Then

rngCell.Offset(0, 9).Activate
Selection.ShowDetail = True

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

End Sub

Thank you very much for your patience.

Greg

[dmthornton]

No problem,

It's beneficial to me as well, since I get to help troubleshoot, see how
others approach projects, and learn different coding techniques.

Take care,

Dave


"GregR" wrote:

> Dave, got it all working. Here it is with all your help
>
> Sub ReturnDetailLoop()
> Const sStr As String = "A2"
> Dim rng1 As Range
> Dim rng2 As Range
> Dim rng As Range
> Dim WBPrj As Workbook
> Dim WBwip As Workbook
> Dim WBPrj2 As Workbook
>
> Set WBPrj = ThisWorkbook
>
> 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"
> Set WBwip = Workbooks("RF 340-000.xls")
> Else
> 'already open
> End If
>
> With WBPrj.Worksheets(1)
> Set rng1 = .Range(.Cells(7, 1), .Cells(Rows.Count,
> 1).End(xlUp))
> End With
> With WBwip.Worksheets(1)
> Set rng2 = .Range(.Cells(7, 1), .Cells(Rows.Count,
> 1).End(xlUp))
> End With
>
> For Each rngproject In rng1.Cells
>
> If rngproject Is Nothing Then
> Exit For
> End If
>
> WBwip.Activate
> With rng2
> Dim rngCell As Range
> Set rngCell = .Find( _
> what:=rngproject, _
> lookat:=xlPart, _
> SearchOrder:=xlByRows, _
> SearchDirection:=xlNext, _
> SearchFormat:=False)
>
> If Not rngCell Is Nothing Then
>
> rngCell.Offset(0, 9).Activate
> Selection.ShowDetail = True
>
> ActiveSheet.Move
> After:=WBPrj.Worksheets(WBPrj.Worksheets.Count)
> ActiveWindow.Zoom = 75
> ActiveSheet.Name = Left(Range(sStr), 6)
> Else
> MsgBox "Project not in WIP"
> End If
> End With
> Next
>
> End Sub
>
> Thank you very much for your patience.
>
> Greg
>
>