Pivot Table macro - strange behaviour

[dusty]

G'Day,

This my first attempt at wotking with pivot tables and trying to
modify the results via a macro.

There must be something I'm missing because:

1. All seems to run according to plan when I execute the code line by
line, but
2.Strange beahviour occurs when I just let it run all the way through
a. one of two tables ends up showing no pivot items and no data
b. Excel stops responding, to all intents and purposes.

What am I trying to do?

First: refresh the pivot tables after loading new source data.

Second: the field called "StartDate2" has items such as "Aug08",
"Jul09", "Apr09", "May09" that I would like sorted in descending
chronological order i.e. "Jul09", "May09", "Apr09", "Aug08".

To achieve the second aim I convert each name of a pivot item to "1
Mmm yy", and then to the date value associated with that string. The
results are stored in an array which are sorted in descending order.

Here's the code, and I really would appreciate any feedback or insight
into why Excel doesn't like to run this outside of debug mode.

Cheers,

Clive
XL2002 SP2
XP Pro 2002 SP3

To test the subroutine:

Sub testpivotrefresh()

Dim wkbk As Workbook
Dim wksht As Worksheet

Dim pvtable As PivotTable


Set wkbk = Workbooks("COF & ITP 24Jun09_cs2.xls")
'Set wkbk = Workbooks("COF & ITP 29Jul09 v1.xls")

Set wksht = wkbk.Worksheets("CoF Breakdown")

wksht.Activate

With ActiveSheet

For Each pvtable In .PivotTables ''only two pivot tables on the
sheet

' If pvtable.Name = "PivotTable5" Then ''similar problems when
using the if statement

Call RefreshAndSortPivotTable(pvtable)

' End If

Next pvtable

End With

Set wkbk = Nothing

Set wksht = Nothing

End Sub ''testpivotrefresh

The subroutine doing the work:
Sub RefreshAndSortPivotTable(pvtable As PivotTable)

'* **************************************** *
'* Creation Details *
'* Date Author *
'* 31/07/2009 *
'* Details *
'* Refreshes pivottable and then sorts *
'* StartDate2 pivot field by date, *
'* descending *
'* *
'* **************************************** *

'* **************************************** *
'* Constants *
'* **************************************** *

'* **************************************** *
'* Variables *
'* **************************************** *

Dim laDate() As Long

Dim intCount As Integer, intRecords As Integer

Dim boolArraySorted As Boolean

Dim strDate As String

'* ***************************************** *
'* Code *
'* ***************************************** *
On Error Resume Next

boolArraySorted = False

With pvtable

''update the table
.RefreshTable

.ManualUpdate = True

With .PivotFields("StartDate2").PivotItems

''rediminesion the array to hold the date entries from
StartDate2 pivot items
ReDim laDate(1 To .Count)

''keep track of the items actually appearing in the pivot
table
intRecords = 0

''load the laDate array
For intCount = 1 To UBound(laDate)

.Parent.PivotItems(intCount).Visible = True

''this will return a range address if the item appears in
the table
''or an error if it does not
''used to trap the error and hence find those that do
really appear
strDate = .Parent.PivotItems(intCount).LabelRange.Address

If Err.Number = 0 Then

''item appears in the pivot table
intRecords = intRecords + 1

laDate(intRecords) = MMMYYtoLong(.Parent.PivotItems
(intCount).Name)

Err.Clear

Else

''clear the error so the next item can be placed in
the list
Err.Clear

End If

Next intCount

''all appearing items should be at the top of the array
''remove the zero elements at the bottom by
''re-dimensioning the array
ReDim Preserve laDate(1 To intRecords)

''sort the laDate array
''use Chip Pearson's routine
boolArraySorted = IsArraySorted(laDate, True)

If Not (boolArraySorted) Then

boolArraySorted = QSortInPlace(laDate, -1&, -1&, True)

End If

''re-order the pivot items and make visible
For intCount = 1 To UBound(laDate)

''change the index to the string that represents the item
strDate = Format(laDate(intCount), "mmmyy")

''make sure it is included
.Parent.PivotItems(strDate).Visible = True

''place in chronological order
.Parent.PivotItems(strDate).Position = intCount

Next intCount

End With ''.PivotFields("StartDate2").PivotItems

''' .ManualUpdate = False

End With ''.pvTable

End Sub ''RefreshAndSortPivotTable

 

[dusty]

G'Day again,

I've stripped the code back to bare minimum and am slowly adding the
details bit by bit.

So far, things turn to custard when

.Parent.PivotItems(intCount).Visible = True


is encountered during the load laDate array process.

Does this help anyine explain what is going on? why the pivot table
loses data and Excel stops responding?

I suspect it really occurs for a pivot item that is not displayed
through lack of criteria matching data.

TIA,

Clive