Excel VBA that Creates a Pivot Table

0
votes

I have this macro that takes all of sheet1 and creates a pivot table of it. However, it is currently only looking at the amount of rows I had when I made it and not the entire sheet no matter how many rows it has that day. Is there any way to make it select all of sheet1 as the pivot table data every time?

If possible I would also like to alter the fix duplicates to be the entire column based on the column name (IDNUMBER) if able.

Range("$A$1:$AM$2428") Range("$A$1:$AM$4000") "PIVOT_STATE_REPORT!R1C1:R1048576C39"

Sub PIVOT_STATE()
'
' PIVOT_STATE Macro
'

'
    'ActiveSheet.Range("$A$1:$AM$2428").RemoveDuplicates Columns:=36, Header:= _
        'xlYes
    Columns("AJ:AJ").Select
    ActiveSheet.Range("$A$1:$AM$4000").RemoveDuplicates Columns:=36, Header:= _
        xlYes
    Range("A2").Select
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "PIVOT_STATE_REPORT!R1C1:R1048576C39", Version:=xlPivotTableVersion15). _
        CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="PivotTable1" _
        , DefaultVersion:=xlPivotTableVersion15
    Sheets("Sheet1").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("State (Corrected)")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Count"), "Sum of Count", xlSum
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Claim Age in CS"), _
        "Sum of Claim Age in CS", xlSum
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Days Since LHN"), _
        "Sum of Days Since LHN", xlSum
    Range("B3").Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Count")
        .Caption = "Count of Count"
        .Function = xlCount
    End With
    Range("C3").Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
        "Sum of Claim Age in CS")
        .Caption = "Average of Claim Age in CS"
        .Function = xlAverage
        .NumberFormat = "0"
    End With
    Range("D3").Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
        "Sum of Days Since LHN")
        .Caption = "Average of Days Since LHN"
        .Function = xlAverage
        .NumberFormat = "0"
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("State (Corrected)")

    End With
End Sub

Thanks in advance!

2
vbaexcel

2 Answers

0
votes

I would use the last row and column formulas provided in this function. Then make the source a combo of these variables. 

Function LastRowColumn(sht As Worksheet, RowColumn As String) As Long
'PURPOSE: Function To Return the Last Row Or Column Number In the Active 
Spreadsheet
'INPUT: "R" or "C" to determine which direction to search

Dim rc As Long

Select Case LCase(Left(RowColumn, 1)) 'If they put in 'row' or column instead of 'r' or 'c'.
  Case "c"
LastRowColumn = sht.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
 Case "r"
   LastRowColumn = sht.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious).Row
 Case Else
  LastRowColumn = 1
End Select

 End Function

Then inside of your macro call out: 

 x = LastRowColumn(ActiveSheet, "column")
 y = LastRowColumn(ActiveSheet, "Row")
 plast = cells(x,y)

Then make a range based off that for the source of the pivot table 

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"PIVOT_STATE_REPORT!A1:" & plast, Version:=xlPivotTableVersion15). _
    CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="PivotTable1" _
    , DefaultVersion:=xlPivotTableVersion15
0
votes

I think the easiest way of doing this will be to replace these lines of your code

Columns("AJ:AJ").Select
ActiveSheet.Range("$A$1:$AM$4000").RemoveDuplicates Columns:=36, Header:=xlYes
Range("A2").Select

With

Dim rData As Range: Set rData = ActiveSheet.Range("A1", ActiveSheet.Range("A1").End(xlDown))
Set rData = Range(rData, rData.End(xlToRight))
rData.RemoveDuplicates Columns:=36, Header:=xlYes
ActiveWorkbook.PivotCaches.Create SourceType:=xlDatabase, SourceData:=rData

The update this be where you make your PivotCache 

`
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
            "PIVOT_STATE_REPORT!R1C1:R1048576C39", Version:=xlPivotTableVersion15). _
            CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="PivotTable1" _
            , DefaultVersion:=xlPivotTableVersion15c
`

With the following code using the rData range as the Source Data

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    rData, Version:=xlPivotTableVersion15). _
    CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="PivotTable1" _
    , DefaultVersion:=xlPivotTableVersion15

Note this assumes that there are no gaps in the columns or rows of your Data. The End(xlDown) is the equivalent of holding the Ctrl and Down key