revision
Public Sub HighlightEstimates(PTable As PivotTable)
Dim vntMatch As Variant
Dim rngDataEntry As Range
Dim lngRow As Long
Dim lngRowDE As Long
Dim strTeam As String
Dim strClient As String
Dim lngYear As Long
Dim strJob As String
Dim blnHighlight As Boolean
Dim lngCol As Long
Dim strMonth As String
Set rngDataEntry = ThisWorkbook.Worksheets("Data Entry Tab").Range("A1").CurrentRegion
strTeam = PTable.Parent.Name
strTeam = PTable.PageFields("Account Team").LabelRange.Offset(0, 1).Value
lngYear = CLng(PTable.PageFields("Year").LabelRange.Offset(0, 1).Value)
For lngCol = 2 To PTable.ColumnRange.Columns.Count
If Len(PTable.ColumnRange.Cells(2, lngCol)) > 0 Then
strMonth = PTable.ColumnRange.Cells(2, lngCol)
End If
For lngRow = 1 To PTable.RowRange.Rows.Count
If PTable.RowRange.Cells(lngRow, 1).IndentLevel = 1 Then
' job
strJob = PTable.RowRange.Cells(lngRow, 1)
blnHighlight = False
For lngRowDE = 2 To rngDataEntry.Rows.Count
If rngDataEntry.Cells(lngRowDE, 1) = strTeam Then
If rngDataEntry.Cells(lngRowDE, 2) = strClient Then
If rngDataEntry.Cells(lngRowDE, 5) = strJob Then
If rngDataEntry.Cells(lngRowDE, 6) = lngYear Then
If rngDataEntry.Cells(lngRowDE, 7) = strMonth Then
If rngDataEntry.Cells(lngRowDE, 12) = "Estimate" Then
blnHighlight = True
Exit For
End If
End If
End If
End If
End If
End If
Next
If blnHighlight Then
Intersect(PTable.ColumnRange.Cells(2, lngCol).MergeArea.EntireColumn, Intersect(PTable.TableRange1, PTable.RowRange(lngRow, 1).EntireRow)).Interior.Color = vbYellow
End If
Else
' client
strClient = PTable.RowRange.Cells(lngRow, 1)
End If
Next
Next
End Sub
Bookmarks