conditional format for vb code on pivot output

  • Thread starter Thread starter BEE
  • Start date Start date
B

BEE

I have been building a pivot table report from a stored
procedure source...

I am getting just the results I want from the stored
procedure - data wise. Now, however, I'd like to
automate the font attributes of the results that appear
in the pivot table once it has been generated. I
recorded a couple of macro's so I could get some idea of
the parts required for this formatting (thanks Bill for
the pointer):

This macro was about highlighting the data in the pivot
as bold when their x and y column headers match. I have
aliases in my code that I am using for for the x and y
axis; will that help?, but how do I locate a/all specific
column and row header axis set?

Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=""c4=a6"""
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
End With

This one was a basic example of how to find the max
amount on the row of the pivot and highlight the largest
one in red, but, so far I have only one cell that would
be highlighted if it meets the condition max.
Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=B5=MAX(5:5)"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With

But, I'm not sure how to manage the multiple locations
(array?) that is a returned pivot and/or how/where to put
this type of code into the rest of my pivot table report
code. I've tried a couple of locations without a great
deal of luck.

If one of you have a chance/some time would you be
willing to give me direction and advice? It's not a rush
job, but I'm having fun and I'm anxious to see more
results.

My code (the resulting pivot table has about 12 columns
and rows):

Public Sub NetworkCrossCheck()
Dim rsReport As New ADODB.Recordset
Dim cnReport As New ADODB.Connection
Dim cmdReport As New ADODB.Command
Dim lrow As Long
Dim lCol As Long
Dim pc As PivotCache
Dim pt As PivotTable
Dim wb As Workbook

On Error GoTo NetworkCrossCheckError

cnReport.ConnectionString = "DSN=MYDB_DEV;"
cnReport.CursorLocation = adUseClient
cnReport.Open

If (cnReport.State <> adStateOpen) Then
MsgBox "Database connection not open, cannot run
query"
Exit Sub
End If

Set cmdReport.ActiveConnection = cnReport
cmdReport.CommandText = "rpt_NetworkCrossCheck_sp"
cmdReport.CommandType = adCmdStoredProc
cmdReport.CommandTimeout = 300

Set rsReport = cmdReport.Execute

Set wb = Workbooks.Open(sPath
& "NetworkCrossCheck_template.xls", 0, True)
Set pc = ActiveWorkbook.PivotCaches.Add
(SourceType:=xlExternal)
Set pc.Recordset = rsReport
pc.CreatePivotTable TableDestination:=Range("A3"),
TableName:="Network Cross Check"


With ActiveSheet.PivotTables("Network Cross Check")
.SmallGrid = False
.RowGrand = False
.ColumnGrand = False

With .PivotFields("NetworkName")
.Orientation = xlRowField
.Position = 1

End With
With .PivotFields("NetworkName1")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("TaxID")
.Orientation = xlDataField
.Position = 1
End With
End With
cnReport.Close
Set rsReport = Nothing
Set cmdReport = Nothing
Set cnReport = Nothing
Set wb = Nothing

Exit Sub

NetworkCrossCheckError:
MsgBox CStr(Err.Number) & ": " & Err.Description &
vbCrLf & "Please call support",
vbExclamation, "NetworkCrossCheck"
Resume Next

End Sub

Thanks in advance,
B
 
For the curious - here's how I solved my dilemma:
Dims added to top:
Dim rc As Integer
Dim counter As Integer
Dim counter2 As Integer
Dim ColPlace As Integer
Dim RowPlace As Integer
Dim MaxValue As Double
Dim MaxCol As Integer

Code:
'rc = get the count of rows in our pivot output
rc = 0
counter = 5 '5 is our data start row
Do While Len(Trim(wb.Sheets(1).Cells(counter, 1).Text)) >
0
counter = counter + 1
rc = rc + 1
Loop

RowPlace = 5
ColPlace = 2

For counter = 0 To rc - 1
wb.Sheets(1).Cells(RowPlace, ColPlace).Font.Bold = True
RowPlace = RowPlace + 1
ColPlace = ColPlace + 1
Next

MaxValue = 0
MaxCol = 2 'starts at col 2
RowPlace = 5
ColPlace = 2
For counter = 0 To rc - 1

For counter2 = 0 To rc - 1
If wb.Sheets(1).Cells(RowPlace, ColPlace).Font.Bold =
False Then
If wb.Sheets(1).Cells(RowPlace, ColPlace).Value >
MaxValue Then
MaxValue = wb.Sheets(1).Cells(RowPlace,
ColPlace).Value
MaxCol = ColPlace
End If
End If
ColPlace = ColPlace + 1
Next
wb.Sheets(1).Cells(RowPlace, MaxCol).Font.ColorIndex
= 3
ColPlace = 2
MaxValue = 0

RowPlace = RowPlace + 1
Next

'place code seen above just before
'Set rsReport = Nothing
 
Bee said:
This macro was about highlighting the data in the pivot
as bold when their x and y column headers match. I have
aliases in my code that I am using for for the x and y
axis; will that help?, but how do I locate a/all specific
column and row header axis set?
Click to expand...

With ActiveCell.PivotTable.DataBodyRange
.Range("A1").Select ' select top left cell of data body
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=" & .Cells(0, 1).Address(ColumnAbsolute:=False) & "=" & _
.Cells(1, 0).Address(RowAbsolute:=False)
With .FormatConditions(1).Font
.Bold = True
.Italic = False
End With
End With
This one was a basic example of how to find the max
amount on the row of the pivot and highlight the largest
one in red, but, so far I have only one cell that would
be highlighted if it meets the condition max.
Click to expand...

before the last End With above, add:

.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=" & .Cells(1,1).Address(RowAbsolute:=False, _
ColumnAbsolute:=False) & "=MAX(" & .Row & ":" & .Row & ")"
With .FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With

Bill Manville
MVP - Microsoft Excel, Oxford, England
No email replies please - reply in newsgroup
 
Back
Top