Slicemahn
08-24-2007, 09:10 AM
Hi Everyone! I probably need a second pair of eyes for this one because I can't find where the error is. It says that I have a Type mismatch error with my pivot table sub routine and would appreciate all the help I can get in finding it.
Sub CreatePivot()
Dim WSD As Worksheet
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim PRange As Range
Dim FinalRow As Long
Set WSD = Worksheets("ExcelView")
' Delete all traces of Pivot Tables within the workbook
For Each PT In WSD.PivotTables
PT.TableRange2.Clear
Next PT
' Define the input area and set up the Pivot Cache
FinalRow = WSD.Cells(65536, 1).End(xlUp).Row
Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 4)
Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceType:=PRange.Address)
Set PT = PTCache.CreatePivotTable(TableDestination:="Sheet1!R3C1", TableName:="TheGoods", DefaultVersion:=xlPivotTableVersion10)
WSD.PivotTables("TheGoods").DisplayErrorString = True
PT.ManualUpdate = True
PT.AddFields RowFields:=Array("TFN", "Area Code")
With PT
.PivotFields ("Area Code")
.Orientation = xlDataField
.Caption = "Count of Area Code"
.Function = xlCount
End With
PT.PivotSelect "TFN[All;Total]", xlDataAndLabel, True
Selection.Delete
End Sub
Sub CopyData()
Dim StartRow As Integer
Dim LastRow As Integer
Dim RowStep As Integer
Dim RowToCopy As Integer
Dim EndRow As Integer
Dim LineStep As Integer
LastRow = Cells(65536, 1).End(xlUp).Row
RowToCopy = 1
For RowStep = 5 To LastRow
If RowStep = LastRow Then
Range("A" & RowStep, "C" & RowStep).Delete
Else
Range("A" & RowStep, "C" & RowStep).Copy Destination:=Sheets("Flattened").Rows(RowToCopy)
End If
RowToCopy = RowToCopy + 1
Next RowStep
Sheets("Flattened").Activate
Cells.Borders.LineStyle = xlNone
EndRow = Cells(65536, 3).End(xlUp).Row
For LineStep = 1 To EndRow
Range("D" & LineStep).Value = Sheets("Report").Cells(3, 5)
If Range("A" & LineStep).Value = "" Then
Range("A" & LineStep).FillDown
End If
Next LineStep
Cells(1, 4).Value = Sheets("Report").Range("E3")
End Sub
Many thanks
Slice
Sub CreatePivot()
Dim WSD As Worksheet
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim PRange As Range
Dim FinalRow As Long
Set WSD = Worksheets("ExcelView")
' Delete all traces of Pivot Tables within the workbook
For Each PT In WSD.PivotTables
PT.TableRange2.Clear
Next PT
' Define the input area and set up the Pivot Cache
FinalRow = WSD.Cells(65536, 1).End(xlUp).Row
Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 4)
Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceType:=PRange.Address)
Set PT = PTCache.CreatePivotTable(TableDestination:="Sheet1!R3C1", TableName:="TheGoods", DefaultVersion:=xlPivotTableVersion10)
WSD.PivotTables("TheGoods").DisplayErrorString = True
PT.ManualUpdate = True
PT.AddFields RowFields:=Array("TFN", "Area Code")
With PT
.PivotFields ("Area Code")
.Orientation = xlDataField
.Caption = "Count of Area Code"
.Function = xlCount
End With
PT.PivotSelect "TFN[All;Total]", xlDataAndLabel, True
Selection.Delete
End Sub
Sub CopyData()
Dim StartRow As Integer
Dim LastRow As Integer
Dim RowStep As Integer
Dim RowToCopy As Integer
Dim EndRow As Integer
Dim LineStep As Integer
LastRow = Cells(65536, 1).End(xlUp).Row
RowToCopy = 1
For RowStep = 5 To LastRow
If RowStep = LastRow Then
Range("A" & RowStep, "C" & RowStep).Delete
Else
Range("A" & RowStep, "C" & RowStep).Copy Destination:=Sheets("Flattened").Rows(RowToCopy)
End If
RowToCopy = RowToCopy + 1
Next RowStep
Sheets("Flattened").Activate
Cells.Borders.LineStyle = xlNone
EndRow = Cells(65536, 3).End(xlUp).Row
For LineStep = 1 To EndRow
Range("D" & LineStep).Value = Sheets("Report").Cells(3, 5)
If Range("A" & LineStep).Value = "" Then
Range("A" & LineStep).FillDown
End If
Next LineStep
Cells(1, 4).Value = Sheets("Report").Range("E3")
End Sub
Many thanks
Slice