Problems with Summary and Pivot Table creation macro

[Handyann]

Hi all,

Firstly, I'm not great with VBA, but I'm learning...slowly.

I am the new treasurer for a local group and need to produce a more detailed overview of the books than the previous treasurer did. So, I've set up a workbook and got the page template and formuli etc to work with no problems. My issue is with a macro that a kind person on another forum wrote for me last year, which should create the summary page and from that the pivot table that I need to extract varying information from.

Last year I was using XL 2007 and have changed to 2010 this month. Previously, the macro didn't fully work as it wouldn't automatically refresh if sheets or data was changed, but it did at least produce a properly set up summary and PT which would populate with available information just on opening the workbook.

Now however, the macro only produces the summary sheet layout, unpopulated with data and still not updating with changes, and won't produce the PT at all. Running the macro also produces a runtime error 1004 'application-defined or object-defined error'.

I've tried tweaking, reloading, putting the macro in different places in the workbook's code modules and spent about 12 solid hours scouring the net for a solution, to no avail.

Could some kind soul please help me out with this before I end up completely bald??!! I have to get the figures presentable by the end of the week I've pasted the macro code below and can upload the workbook if you can tell me how please.

Many thanks in anticipation,
Ann

Sub ConsolidateCreatePT()
Dim wSumSht As Worksheet
Dim i As Integer
Dim j As Integer
Dim r As Long
Dim rngC As Range
Dim iCnt As Integer
Dim PF As PivotField


On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False
Worksheets("Summary").Delete
Worksheets("Pivot Table").Delete
Application.DisplayAlerts = True
On Error GoTo 0

Set wSumSht = Worksheets.Add(Before:=Worksheets(1))
wSumSht.Name = "Summary"
wSumSht.Cells(1, 1).Value = "Month"
wSumSht.Cells(1, 2).Value = "Type"
wSumSht.Cells(1, 3).Value = "Description"
wSumSht.Cells(1, 4).Value = "Category"
wSumSht.Cells(1, 5).Value = "Amount"

For i = 2 To Worksheets.Count

Set rngC = Worksheets(i).Cells.Find("ITEM (income)")
If Not rngC Is Nothing Then
Set rngC = rngC.CurrentRegion
iCnt = rngC.Rows.Count - 1

r = wSumSht.Cells(wSumSht.Rows.Count, 3).End(xlUp).Row + 1

rngC.Offset(1).Resize(iCnt).Copy _
wSumSht.Cells(r, 3)
wSumSht.Cells(r, 1).Resize(iCnt).Value = Worksheets(i).Name
wSumSht.Cells(r, 2).Resize(iCnt).Value = "Income"
End If

Set rngC = Worksheets(i).Cells.Find("ITEM (Expenditure)")
If Not rngC Is Nothing Then
Set rngC = rngC.CurrentRegion
iCnt = rngC.Rows.Count - 1

r = wSumSht.Cells(wSumSht.Rows.Count, 3).End(xlUp).Row + 1

rngC.Offset(1).Resize(iCnt).Copy _
wSumSht.Cells(r, 3)
wSumSht.Cells(r, 1).Resize(iCnt).Value = Worksheets(i).Name
wSumSht.Cells(r, 2).Resize(iCnt).Value = "Expenditure"
For j = 1 To iCnt
wSumSht.Cells(r, 5).Offset(j - 1).Value = -wSumSht.Cells(r, 5).Offset(j - 1).Value
Next j
End If
Next i

wSumSht.Cells.EntireColumn.AutoFit

Set wPT = Worksheets.Add(Before:=Worksheets(1))
wPT.Name = "Pivot Table"
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
Worksheets("Summary").Range("A1").CurrentRegion.Address(False, False, xlR1C1, True), _
Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="'Pivot Table'!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion14
With wPT.PivotTables("PivotTable1").PivotFields("Month")
.Orientation = xlRowField
.Position = 1
End With
With wPT.PivotTables("PivotTable1").PivotFields("Type")
.Orientation = xlColumnField
.Position = 1
End With
wPT.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Amount"), "Sum of Amount", xlSum
With wPT.PivotTables("PivotTable1").PivotFields("Description")
.Orientation = xlRowField
.Position = 2
End With
With wPT.PivotTables("PivotTable1").PivotFields("Category")
.Orientation = xlRowField
.Position = 3
End With
With wPT.PivotTables("PivotTable1")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
For Each PF In wPT.PivotTables("PivotTable1").PivotFields
PF.Subtotals(1) = False
Next PF

Application.EnableEvents = True

End Sub