Macro to create a pivot with variable rows.

Hi Guys

I am attempting to create a Macro which will create a pivot. I intend to place a button on the screen so others can run it.

I have researched the net and come up with the following solution

Sub CreatePivot()
'
' CreatePivot Macro
'

       FianlRow = Cells(Rows.Count, 1).End(xlUp).Row
    DataSheet = ActiveSheet.Name
    NewSheet = ActiveSheet.Name
    ActiveCell.Offset(39, 1).Range("A1").Select
    Sheets.Add
     NewSheet = ActiveSheet.Name
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        DataSheet & "!R2C1:R & FinalRow & C17", Version:=xlPivotTableVersion14). _
        CreatePivotTable TableDestination: NewSheet & "!R3C1", TableName:="PivotTable2",
      DefaultVersion:=xlPivotTableVersion14
    Sheets(NewSheet).Select

Then carries on with the actual manipulation within the pivot. This part does not work for me. I have not found a solution in this forum but I am sure that you will immediately see where the problem is. I got this from http://www.youtube.com/watch?v=UkPxhlW9Hd0

Have uploaded the file.

Any suggestions would be great.

Thanks
Mark

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code in [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

Try changing

SourceData:= _
        DataSheet & "!R2C1:R & FinalRow & C17"

to

SourceData:= _
        DataSheet & "!R2C1:R" & FinalRow & "C17"

Change

TableDestination:NewSheet

to

TableDestination:=NewSheet

Try this:

Sub CreatePivot()
    Dim PT              As Excel.PivotTable
    Dim PC              As Excel.PivotCache
    Dim FinalRow        As Long
    Dim DataSheet       As String
    Dim NewSheet        As String
    Dim vItem
    Dim vCurrItems
    
    vCurrItems = Array("Rate", "Supplier", "Internal", "External", "Total", "Profit", "Quote")
    Const sCURR_FORMAT As String = "_-[$£-809]* #,##0.00_-;-[$£-809]* #,##0.00_-;_-[$£-809]* ""-""??_-;_-@_-"
    
    Application.ScreenUpdating = False
    With Sheets("Segmentise  cost")
        FinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        DataSheet = .Name
    End With
    NewSheet = Sheets.Add.Name
    
    Set PC = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                    SourceData:="'" & DataSheet & "'!R2C1:R" & FinalRow & "C17", _
                    Version:=xlPivotTableVersion14)
    
    Set PT = PC.CreatePivotTable(TableDestination:="'" & NewSheet & "'!R3C1", _
                    TableName:="PivotTable2", DefaultVersion:=xlPivotTableVersion14)
    
    With PT
        .ManualUpdate = True
        With .PivotFields("Order 2")
            .Orientation = xlRowField
            .Position = 1
        End With
        .AddDataField .PivotFields("Order"), "-Order", xlSum
        .AddDataField .PivotFields("Int/Ex"), "-Int/Ex", xlSum
        .AddDataField .PivotFields("Phase"), "-Phase", xlSum
        .AddDataField .PivotFields("Country"), "-Country", xlSum
        .AddDataField .PivotFields("Options"), "-Options", xlSum
        .AddDataField .PivotFields("Days"), "-Days", xlSum
        .AddDataField .PivotFields("Respd."), "-Respd.", xlSum
        .AddDataField .PivotFields("Staff"), "-Staff", xlSum
        For Each vItem In vCurrItems
            With .PivotFields(vItem)
                .Caption = "-" & vItem
                .Orientation = xlDataField
                .Function = xlSum
                .NumberFormat = sCURR_FORMAT
            End With
        Next vItem
        With .PivotFields("Order 2")
            .PivotItems("(blank)").Visible = False
            .AutoSort xlAscending, "-Order", PT.PivotColumnAxis.PivotLines(1), 1
        End With
        .ManualUpdate = False
    End With
    ActiveWorkbook.ShowPivotTableFieldList = False
    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub

Revised version with comments and the sorting issue fixed:

Sub CreatePivot()
    Dim PT              As Excel.PivotTable
    Dim PC              As Excel.PivotCache
    Dim FinalRow        As Long
    Dim DataSheet       As String
    Dim NewSheet        As String
    Dim vItem
    Dim vCurrItems
    
    ' this is an array of the currency fields
    vCurrItems = Array("Rate", "Supplier", "Internal", "External", "Total", "Profit", "Quote")
    ' number format to apply to the fields listed above
    Const sCURR_FORMAT As String = "_-[$£-809]* #,##0.00_-;-[$£-809]* #,##0.00_-;_-[$£-809]* ""-""??_-;_-@_-"
    ' turn off screen updating to speed code up
    Application.ScreenUpdating = False
    
    With Sheets("Segmentise  cost")
        ' get last used row in col A on data sheet
        FinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        DataSheet = .Name
    End With
    ' add new sheet and store its name
    NewSheet = Sheets.Add.Name
    
    ' create the data cache
    Set PC = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                    SourceData:="'" & DataSheet & "'!R2C1:R" & FinalRow & "C17", _
                    Version:=xlPivotTableVersion14)
    ' create the pivot
    Set PT = PC.CreatePivotTable(TableDestination:="'" & NewSheet & "'!R3C1", _
                    TableName:="PivotTable2", DefaultVersion:=xlPivotTableVersion14)
    
    With PT
        ' prevent the pivot from updating while we're changing the layout, just to speed processing
        .ManualUpdate = True
        ' add row field
        With .PivotFields("Order 2")
            .Orientation = xlRowField
            .Position = 1
        End With
        ' add data fields, setting caption and using Sum function
        .AddDataField .PivotFields("Order"), "-Order", xlSum
        .AddDataField .PivotFields("Int/Ex"), "-Int/Ex", xlSum
        .AddDataField .PivotFields("Phase"), "-Phase", xlSum
        .AddDataField .PivotFields("Country"), "-Country", xlSum
        .AddDataField .PivotFields("Options"), "-Options", xlSum
        .AddDataField .PivotFields("Days"), "-Days", xlSum
        .AddDataField .PivotFields("Respd."), "-Respd.", xlSum
        .AddDataField .PivotFields("Staff"), "-Staff", xlSum
        
        ' loop through the currency fields adding them to the data area and formatting them
        For Each vItem In vCurrItems
            With .PivotFields(vItem)
                .Caption = "-" & vItem
                .Orientation = xlDataField
                .Function = xlSum
                .NumberFormat = sCURR_FORMAT
            End With
        Next vItem
        ' allow the pivot table to update so that we can sort
        .ManualUpdate = False
        
        With .PivotFields("Order 2")
            .PivotItems("(blank)").Visible = False
            .AutoSort xlAscending, "-Order", PT.PivotColumnAxis.PivotLines(1), 1
        End With
    End With
    'hide field list
    ActiveWorkbook.ShowPivotTableFieldList = False
    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub