PDA

View Full Version : VBA Pivot Table Creation Doesn't Sum all Rows



IonutC
06-27-2018, 02:49 AM
Hi guys,


I am trying to understand why my PT doesn't sum all of the existing rows. I would need your expert oppinion on this problem. Somehow is taking only a part of the existing rows into consideration. My Database is in the PivotTable sheet and from there is taking the information for the Pivot Table. Into the PT the Pivot will be populated with all the desired columns.
My issue is:


PivotTable:


Col J equals 12
Col L equals 7
Col N equals 5

PT
The same column from PivotTable(J) is E here and equals 7.
The same column is J here and equals 0
The same column is I here and equals 2

If you could help me, i would owe you a lot!
PS I dont know how to attach a file here.


Sub CreatePivot_New()
Dim WSD As Worksheet
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim PRange As Range
Dim FinalRow As Long
Set WSD = Worksheets("PivotTable")
Set WSD1 = Worksheets("PT")

WSD1.Activate
Range("A1:L12").Select
Selection.Delete

WSD.Activate
' Delete any prior pivot tables
For Each PT In WSD.PivotTables
PT.TableRange2.Clear
Next PT

Range("O2:T13").Select
Selection.Delete

' Define input area and set up a Pivot Cache
FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
FinalCol = WSD.Cells(1, Application.Columns.Count). _
End(xlToLeft).Column
Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
xlDatabase, SourceData:=PRange.Address)

' Create the Pivot Table from the Pivot Cache
Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
Cells(2, FinalCol + 2), TableName:="PivotTable1")

' Turn off updating while building the table
' PT.ManualUpdate = True

' Set up the row & column fields
PT.AddFields RowFields:="Language", ColumnFields:="Data"


' Set up the data fields

With PT.PivotFields("Language")
'.Orientation = xlDataField
.Orientation = xlRowField
'.Function = xlCount
.Position = 1
'.NumberFormat = "#,##0"
.Name = "Languages "
End With


With PT.PivotFields("HC Plan")
.Orientation = xlDataField
.Position = 1
.NumberFormat = "#,##0"
.Name = "HC Plan "
End With

With PT.PivotFields("On-boarded")
.Orientation = xlDataField
.Function = xlSum
.Position = 2
.NumberFormat = "#,##0"
.Name = "Onboarded"
End With

With PT.PivotFields("Pending Starts /Offer Accepts")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
.Position = 3
.Name = "Pending Starts Offer Accepts"
End With

With PT.PivotFields("Offer Extended & To Offer")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
.Position = 4
.Name = "Offer Extended and To Offer"
End With

With PT.PivotFields("Left")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
.Position = 5
.Name = "Total Numer of Left"
End With

With PT.PivotFields("Total Declines")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
.Position = 6
.Name = "Total Number of Declines"
End With

With PT.PivotFields("Confirmed Interviews")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
.Position = 7
.Name = "Confirmed Interviewss"
End With

' ' Calc the pivot table
' PT.ManualUpdate = False
' PT.ManualUpdate = True

'Format the pivot table
PT.ShowTableStyleRowStripes = True
PT.TableStyle2 = "PivotStyleMedium10"
With PT
.ColumnGrand = True
.RowGrand = True
.RepeatAllLabels xlRepeatLabels
End With

'Copiere in PT

PT.ManualUpdate = True
Application.CutCopyMode = False
PT.TableRange2.Offset(1, 0).Copy
WSD1.Activate
WSD1.Cells(1, 1).PasteSpecial xlPasteValues
ThisWorkbook.Worksheets("PT").Cells.EntireColumn.AutoFit


WSD1.Range("D1:H11").Select
Selection.Cut
Range("D21").Select
ActiveSheet.Paste
'PT.TableRange2.Clear
Set PTCache = Nothing

'Adaugare de Variance to Plan
Range("D1") = "Variance to Plan"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D11"), Type:=xlFillDefault

'Adaugare Pending Starts Offert Accepts
Range("D21:D31").Select
Selection.Cut
Range("E1").Select
ActiveSheet.Paste

'Adaugare Variance after offer accepts
Range("F1") = "Variance after offer accepts"
Range("F2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
Range("F2").Select
Selection.AutoFill Destination:=Range("F2:F11"), Type:=xlFillDefault

'Adaugare Offer Extended and To Offer
Range("E21:E31").Select
Selection.Cut
Range("G1").Select
ActiveSheet.Paste

'Adaugare Due
Range("H1") = "Due"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H11"), Type:=xlFillDefault

'Adaugare de Total Number of Declines
Range("G21:G31").Select
Selection.Cut
Range("I1").Select
ActiveSheet.Paste

'Adaugare Confirmed Interviews
Range("H21:H31").Select
Selection.Cut
Range("J1").Select
ActiveSheet.Paste
Range("J1") = "Confirmed Interviews"
Application.CutCopyMode = True

'Adaugare de Total Numer of Left
Range("F21:F31").Select
Selection.Cut
Range("L1").Select
ActiveSheet.Paste

'Adaugare Total Selected col K
Range("K1") = "Total Selected"
Range("K2").Select
ActiveCell.FormulaR1C1 = "=RC[-8]+RC[-6]+RC[-5]+RC[-3]"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K11"), Type:=xlFillDefault

'Stilizare FInala Pivot Final Ca sa fie Portocaliu
Range("A1:L11").Select
Range("L11").Activate
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$L$11"), , xlYes).Name = "Table1"
Range("Table1[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium3"
'Aplicam Bold pe Total
Range("A11:L11").Select
Selection.Font.Bold = True
Range("A1").Select
ThisWorkbook.Worksheets("PT").Cells.EntireColumn.AutoFit
Call DeletePTandRest
End Sub

IonutC
06-27-2018, 02:56 AM
i saw in the local window, that FinalRow is 474 and it should have been 491. do you know how i can fix this?

IonutC
06-27-2018, 03:01 AM
solved! issue with col A and FR