Guest User

Untitled

a guest
Jan 20th, 2019
76
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.87 KB | None | 0 0
  1. Case Number Branch Driver
  2. 1342 NYC Bob
  3. 4532 PHL Jim
  4. 7391 CIN John
  5. 8251 SAN John
  6. 7211 SAN Mary
  7. 9121 CLE John
  8. 7424 CIN John
  9.  
  10. Driver NYC PHL CIN SAN CLE
  11. Bob 1 0 0 0 0
  12. Jim 0 1 0 0 0
  13. John 0 0 2 1 1
  14. Mary 0 0 0 1 0
  15.  
  16. Sub CreateSummaryReportUsingPivot()
  17. ' Use a Pivot Table to create a static summary report
  18. ' with model going down the rows and regions across
  19. Dim WSD As Worksheet
  20. Dim PTCache As PivotCache
  21. Dim PT As PivotTable
  22. Dim PRange As Range
  23. Dim FinalRow As Long
  24. Dim FinalCol As Long
  25. Set WSD = Worksheets("PivotTable")
  26.  
  27. 'Name active worksheet as "PivotTable"
  28. ActiveSheet.Name = "PivotTable"
  29.  
  30. ' Delete any prior pivot tables
  31. For Each PT In WSD.PivotTables
  32. PT.TableRange2.Clear
  33. Next PT
  34.  
  35. ' Define input area and set up a Pivot Cache
  36. FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
  37. FinalCol = WSD.Cells(1, Application.Columns.Count). _
  38. End(xlToLeft).Column
  39. Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
  40. Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
  41. xlDatabase, SourceData:=PRange)
  42.  
  43. ' Create the Pivot Table from the Pivot Cache
  44. Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
  45. Cells(2, FinalCol + 2), TableName:="PivotTable1")
  46.  
  47. ' Turn off updating while building the table
  48. PT.ManualUpdate = True
  49.  
  50. ' Set up the row fields
  51. PT.AddFields RowFields:="Driver", ColumnFields:="Branch"
  52.  
  53. ' Set up the data fields
  54. With PT.PivotFields("Case Number")
  55. .Orientation = xlDataField
  56. .Function = xlCount
  57. .Position = 1
  58. End With
  59.  
  60. With PT
  61. .ColumnGrand = False
  62. .RowGrand = False
  63. .NullString = "0"
  64. End With
  65.  
  66. ' Calc the pivot table
  67. PT.ManualUpdate = False
  68. PT.ManualUpdate = True
  69.  
  70. End Sub
  71.  
  72. PivotCaches.Create
Add Comment
Please, Sign In to add comment