Hi

I think the major problem is that you try to put whole of spreadsheet into
the Pivot Caches.

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatab ase, _
SourceData:= "'52'!A1:C65536")


Try to use find to locate the cell that is the top left of data then use
select xldown and select right to retrive the address of the data range that
you need to perform pivot table.

1. use find to locate the lable which listing the data
2. use offset in case which is the next cell or the cell below
3. then use select right and select down, or select down then select right

i think as long as you elimiate those unnecessary cells then it will help to
speed up.

hope this help.


"Zarlot531" wrote:

The problem could lie in the fact that I believe I'm having it scan
every single row several times. What I would like to do eventually is
run this macro on about 10 different sets of sheets at a time, getting
the pivot table report for each one. Basically, the problem i had
was that I had two reports I needed to run a pivot table on, but the
data were presented along with other text etc. and the reports rows
varied by day , etc. So, this macro creates the pivot table
information I need to find discprancies without me having to sort,
copy, paste, run the pivot table etc.

But, like I said, while it is still is going to save me time
(especially if I could do 10-15 at once), it's running slow.

Thanks for any suggestions.
__________________________________

Sub DelRw()
Dim lstRw
Dim i
Dim x
Dim CalcMode As Long
Dim Cell As Range
Dim g
Dim z
Dim MstRw
Dim ViewMode As Long





With Application
CalcMode = .Calculation
..Calculation = xlCalculationManual
..ScreenUpdating = False
End With
Sheets("52").Select
Columns("A").Select
Selection.TextToColumns Destination:=Range("A1"),
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(20, 1), Array(34, 1),
Array(42, 1), Array(52, 1), _
Array(54, 1), Array(66, 1), Array(76, 1), Array(86, 1),
Array(108, 1)), _
TrailingMinusNumbers:=True
Columns("C:G").Select
Selection.Delete Shift:=xlToLeft
lstRw = Cells(Rows.Count, 1).End(xlUp).Row
For i = lstRw To 1 Step -1
x = Cells(i, 3).Value
If Left(x, 4) < "2745" Then
Cells(i, 3).EntireRow.Delete
End If
Next

Columns("E").Select
For Each Cell In Selection
If Cell.Value = 0 Then
Cell.ClearContents
Else: Cell.Offset(0, -1).Value = Cell.Value * -1
Cell.ClearContents
End If
Next Cell
Columns("C").Select
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Code"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Mar"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Amount"

Sheets("64").Select
Columns("A").Select
Selection.TextToColumns Destination:=Range("A1"),
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(26, 1), Array(48, 1),
Array(76, 1), Array(95, 1), _
Array(108, 1)), TrailingMinusNumbers:=True
Columns("F").Select
For Each Cell In Selection
If Cell.Value < "F" Then
Cell.ClearContents
Else
End If
Next


MstRw = Cells(Rows.Count, 1).End(xlUp).Row
For z = MstRw To 1 Step -1
g = Cells(z, 6).Value
If Left(g, 1) < "F" Then
Cells(z, 6).EntireRow.Delete
End If
Next
Columns("A").Select
Selection.Delete Shift:=xlToLeft
Columns("C").Select
Selection.Delete Shift:=xlToLeft
Columns("C").Select
Selection.Delete Shift:=xlToLeft
Columns("C").Select
Selection.Delete Shift:=xlToLeft
Columns("B").Select
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Columns("C:C").Select
Selection.Cut Destination:=Columns("D:D")
Columns("B:B").Select
Selection.Cut Destination:=Columns("C:C")
Columns("D:D").Select
Selection.Cut Destination:=Columns("B:B")
Columns("B:B").Select

For Each Cell In Selection
If Cell.Value 0 Then
Cell.Offset(0, -1).Value = 64
Else
End If
Next
Columns("C").Select
For Each Cell In Selection
If Cell.Value = 0 Then
Cell.ClearContents
Else: Cell.Offset(0, 1).Value = Cell.Value * -1
Cell.ClearContents
End If
Next Cell
Columns("C").Select
Selection.Delete Shift:=xlToLeft



Dim destSht As Worksheet
Dim srcSht As Worksheet
Dim NextRow As Long


Set destSht = Sheets("52")
Set srcSht = Sheets("64")


NextRow = destSht.Cells(destSht.Rows.Count, 1).End(xlUp).Row + 1


'source sheet has a heading that I have to exclude from copy
srcSht.Cells(1).CurrentRegion.Copy


'I can choose to paste values
destSht.Cells(NextRow, 1).PasteSpecial xlPasteAll

Sheets("52").Select
Columns("A:C").Select
Range("C1").Activate
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatab ase,
SourceData:= _
"'52'!A1:C65536").CreatePivotTable TableDestination:="",
TableName:= _
"PivotTable2", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard
TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable2").AddFields RowFields:="Mar",
_
ColumnFields:="Code"
With ActiveSheet.PivotTables("PivotTable2").PivotFields ("Amount")
.Orientation = xlDataField
.Caption = "Sum of Amount"
.Function = xlSum
End With






End Sub