PivotTable code does not return any object.

[Jun]

The following code (code after the line here...) does not return any object.
This situation is intermittent. What are the possible scenarios this would
be so?

Here's a portion of the codes. The objPivotTable is not defined when the
Category is set as PivotTable column and there is no data under selected
category.

Private Sub CheckPageForAll()
'Ensures that "(All)" is not selected for Page Fields except with Channels
and Demo Types
Const sRoutineName = "CheckPageForAll"
Dim sDimension As String
Dim objPivotTable As PivotTable
Dim objPivotField As PivotField
Dim sMessage As String

On Error GoTo err_proc

// Here...
Set objPivotTable =
ThisWorkbook.Worksheets("Data").PivotTables("PivotTable1")
// ...Here

For Each objPivotField In objPivotTable.PageFields
With objPivotField

sDimension = .CubeField.Caption

Select Case sDimension
Case "Geography"
If StrComp(.DataRange.Value, GetFromINI("SIFP",
"Country"), vbTextCompare) <> 0 Then
sMessage = sMessage & Chr(183) & " Page field '" &
sDimension & "' " & _
"is set to '" & .DataRange.Value & "'. Due to
technical reasons '" & sDimension & "' " & _
"can only be changed within the Shoppers Insight
Front Page " & _
"portion of this application. '" & sDimension &
"' has been reset automatically." & Chr(13) & Chr(13)

GetSelections .Caption, .Value
End If
Case "Channel", "Category", "Demographic Type", "Attribute
Type"
Case Else
If .DataRange.Value = "All" Then
If InStr(1, Right(getCurrentPageName(objPivotField),
12), ".[All].[All]", vbTextCompare) <> 1 Then
sMessage = sMessage & Chr(183) & " Page field
'" & sDimension & "' " & _
"is set to 'All'. This value will cause the
results of your report to be erroneous." & Chr(13) & _
"Change to a value other than 'All'." &
Chr(13) & Chr(13)
End If
End If
End Select
End With
Next objPivotField
If sMessage <> "" Then
WriteError sMessage, gnERR_WARNING, 0, "", "", ""
End If

exit_proc:
Set objPivotField = Nothing
Set objPivotTable = Nothing
Exit Sub
Resume
err_proc:
'Catch error when there is no data in cub file
If Err.Number = 1004 Or Err.Number = 91 Or Err.Number = 92 Then Resume
Next
WriteError "Dimension:" & sDimension, gnERR_GENERAL, Err.Number,
Err.Description, sRoutineName, msModuleName
GoTo exit_proc
End Sub

 

[Cindy M.]

Hi Jun,

The following code (code after the line here...) does not return any object.
This situation is intermittent. What are the possible scenarios this would
be so?

I recommend you take this to the more specialized excel.programming newsgroup.
That's where the experts tend to congregate

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 17 2005)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question or reply
in the newsgroup and not by e-mail