Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

VBA Excel 2000 - Sorting values of pivot

Posted on 2011-02-17
4
Medium Priority
?
578 Views
Last Modified: 2013-04-16
Dear Experts,

In the attached file or in Code section there is a macro, which creates pivot and works fine. (with the help of several EE experts :-))

I would search a solution to this part

'Sorting
Range("A11:E22").Select
Selection.Sort Key1:="R11C5", Order1:=xlDescending, Type:=xlSortValues, _
        OrderCustom:=1, Orientation:=xlTopToBottom


Basically it works but just for actual range, and that can change later. Could be this done somehow with referring to pivot attribute? So like maybe the conditional formatting part works, referring to 'Row Grand Total'.

thanks,
Sub PivotCreation()

'Count actual base sheet rows
Dim LastRowWithValue As Long
LastRowWithValue = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count

'Source and Place
     ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R" & LastRowWithValue & "C3").CreatePivotTable TableDestination:=ActiveWorkbook.Worksheets("Sheet2").Range("A9"), _
        TableName:="PivotTable1"
'Always
    ActiveWorkbook.Worksheets("Sheet2").Activate
    ActiveSheet.PivotTables("PivotTable1").SmallGrid = False
'Column, Row fields
    ActiveSheet.PivotTables("PivotTable1").AddFields RowFields:= _
        "Item", ColumnFields:="Area"
'Data fields
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Qty")
        .Orientation = xlDataField
        .NumberFormat = "# ##0"
        .Function = xlSum
    End With
'Afterwards Sum if needed
    'ActiveSheet.PivotTables("PivotTable1").PivotFields( _
    '  "Count of Qty").Function = xlSum
'Certain columns not visible
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Area")
        .PivotItems("West").Visible = False
    End With
'Columns replace and order
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Area").PivotItems( _
        "South").Position = 1
'Conditional formatting
ActiveSheet.PivotTables("PivotTable1").PivotSelect "'Row Grand Total'", xlDataAndLabel
    With Selection
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
            , Formula1:="2000"
        .FormatConditions(1).Interior.ColorIndex = 4
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
            Formula1:="2000"
        .FormatConditions(2).Interior.ColorIndex = 3
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotSelect "'Column Grand Total'", xlDataAndLabel
    Selection.FormatConditions.Delete
'Sorting
Range("A11:E22").Select
Selection.Sort Key1:="R11C5", Order1:=xlDescending, Type:=xlSortValues, _
        OrderCustom:=1, Orientation:=xlTopToBottom

'Paste special as values
'    ActiveSheet.PivotTables("PivotTable1").TableRange2.Copy
'    ActiveSheet.PivotTables("PivotTable1").TableRange2.PasteSpecial Paste:=xlPasteValues
End Sub

Open in new window

PivotVBATemplate.xls
0
Comment
Question by:csehz
  • 2
  • 2
4 Comments
 
LVL 85

Accepted Solution

by:
Rory Archibald earned 2000 total points
ID: 34915383
Try this:
Sub PivotCreation()

'Count actual base sheet rows
Dim LastRowWithValue As Long
Dim PT As PivotTable
LastRowWithValue = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count

'Source and Place
     Set PT = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R" & LastRowWithValue & "C3").CreatePivotTable(TableDestination:=ActiveWorkbook.Worksheets("Sheet2").Range("A9"), _
        TableName:="PivotTable1")
'Always
    With PT
      .Parent.Activate
      .SmallGrid = False
'Column, Row fields
    .AddFields RowFields:="Item", ColumnFields:="Area"
'Data fields
    With .PivotFields("Qty")
        .Orientation = xlDataField
        .NumberFormat = "# ##0"
        .Function = xlSum
    End With
'Afterwards Sum if needed
    'ActiveSheet.PivotTables("PivotTable1").PivotFields( _
    '  "Count of Qty").Function = xlSum
'Certain columns not visible
    .PivotFields("Area").PivotItems("West").Visible = False
'Columns replace and order
    .PivotFields("Area").PivotItems("South").Position = 1
'Conditional formatting
   .PivotSelect "'Row Grand Total'", xlDataAndLabel
    With Selection
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
            , Formula1:="2000"
        .FormatConditions(1).Interior.ColorIndex = 4
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
            Formula1:="2000"
        .FormatConditions(2).Interior.ColorIndex = 3
    End With
    .PivotSelect "'Column Grand Total'", xlDataAndLabel
    Selection.FormatConditions.Delete
'Sorting
   .PivotFields("Item").AutoSort xlDescending, "Sum of Qty"
End With
'Paste special as values
'    ActiveSheet.PivotTables("PivotTable1").TableRange2.Copy
'    ActiveSheet.PivotTables("PivotTable1").TableRange2.PasteSpecial Paste:=xlPasteValues
End Sub

Open in new window

0
 
LVL 1

Author Closing Comment

by:csehz
ID: 34915418
That works fine :-) Thanks very much
0
 
LVL 1

Author Comment

by:csehz
ID: 34915464
I can just realize now, that you reworked also my beginner logic with defining variable PT as PivotTable, and after all of the pivot attributes based on that.

Super like this, this is the case that I thanked you something, and later understood that should thank more :-)))
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 34915475
It's force of habit - I didn't even think about it really! :)
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This article describes a serious pitfall that can happen when deleting shapes using VBA.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

916 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question