I've the Pivot Table in Sheet 1 and in VBA I've the following code to sort another PivotTable in the same sheet based on Update event.
Event Code
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
If Target = "PivotTable1" Then
ActiveSheet.PivotTables("75Percentile").PivotFields( _
"[DimCustomer].[Customer Desc].[Customer Desc]").ClearAllFilters
ActiveSheet.PivotTables("75Percentile").PivotFields( _
"[DimCustomer].[Customer Desc].[Customer Desc]").PivotFilters.Add2 Type:= _
xlValueIsGreaterThan, DataField:=ActiveSheet.PivotTables("75Percentile"). _
CubeFields("[Measures].[Sales Qty (Van Sales)]"), Value1:=Range("F5").Value
Call Module1.SortGold
End If
End Sub
Inside this code I try to call Module1.SortGold that is:
Module Code
Sub SortGold()
ActiveWorkbook.Worksheets("Gold").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Gold").AutoFilter.Sort.SortFields.Add Key:=Range( _
"E2:E5001"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Gold").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
That should sort values in another sheet (Gold). Unfortunately It seems that the module wont trigger. If I run with F5 the module the table is sorted correctly so the problem is launching the module...
Any thoughts?
Try this modification:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Application.EnableEvents = False
If Target = "PivotTable1" Then
ActiveSheet.PivotTables("75Percentile").PivotFields( _
"[DimCustomer].[Customer Desc].[Customer Desc]").ClearAllFilters
ActiveSheet.PivotTables("75Percentile").PivotFields( _
"[DimCustomer].[Customer Desc].[Customer Desc]").PivotFilters.Add2 Type:= _
xlValueIsGreaterThan, DataField:=ActiveSheet.PivotTables("75Percentile"). _
CubeFields("[Measures].[Sales Qty (Van Sales)]"), Value1:=Range("F5").Value
Call Module1.SortGold
End If
Application.EnableEvents = True
End Sub
Related
I have an accounting system that creates a report from SQL database, it puts the report data on sheet1(Report) and report paramters on sheet 2.
i need to sort the data and hide a few columns when the accounting system has complted the dump
on sheet1 i put the following code
Private Sub Worksheet_Change(ByVal Target As Range)
Sort
HideExtraFields
End Sub
in module1
Sub Sort()
Selection.AutoFilter
ActiveWorkbook.Worksheets("Report").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Report").AutoFilter.Sort.SortFields.Add Key:=Range _
("E2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
ActiveWorkbook.Worksheets("Report").AutoFilter.Sort.SortFields.Add Key:=Range _
("D2"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Report").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
End Sub
Sub HideExtraFields()
Columns("AA:AE").Select
Selection.EntireColumn.Hidden = True
End Sub
if i move the code on sheet1 to ThisWorkbook, i get error for it is still dumping paramters on sheet2
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Sort
HideExtraFields
End Sub
You're just sorting, AutoFilter is not needed for sorting; drop it and drop the use of the hazardous Selection stuff. Try it this way.
Preferably, I will put all in the code module of the worksheet Report
' Code Module of the worksheet Report
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
SortMe
HideExtraFields
End Sub
Sub SortMe()
With Me.Sort.SortFields
.Clear
.Add Key:=Me.Range("E2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
.Add Key:=Me.Range("D2"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
End With
With Me.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.SetRange Me.UsedRange
.Apply
End With
End Sub
Sub HideExtraFields()
Me.Columns("AA:AE").Hidden = True
End Sub
I am trying to trigger a macro with a drop down list. So far I have a working macro which selects and sorts data by column from greatest to smallest. The macro works perfectly.
Example Macro:
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Option+Cmd+s
'
Range("A1:AO125").Select
Range("A2").Activate
ActiveWorkbook.Worksheets("Test Model").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Test Model").Sort.SortFields.Add Key:=Range( _
"R2:R125"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Test Model").Sort
.SetRange Range("A1:AO125")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("C7").Select
End Sub
I would like to trigger this macro with a drop down list. I have created the drop down list and have written some syntax in VB editor under the excel's workbook column.
Here is the syntax so far:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J15")) Is Nothing Then
Select Case Range("J15")
Case "Engagement Rate % ": Macro1
End Select
End If
End Sub
When I try to run the code nothing happens... Can someone help me with my syntax?
I have added a snapshot of my screen below to help with the explaining.
Just modify your code in Worksheet_Change event to the code below.
This will call Macro1 if the value in Cell "J15" is "Engagement Rate % " (with a space at the end ? !).
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True ' <-- just for tests
If Not Intersect(Target, Range("J15")) Is Nothing Then
Select Case Target.Value
Case "Engagement Rate % "
Macro1
End Select
End If
End Sub
And try this code instead of your "Macro1" (see if the MsgBox pops):
Option Explicit
Sub Macro1()
' Macro1 Macro
' Keyboard Shortcut: Option+Cmd+s
MsgBox "Hello Test"
'Range("A1:AO125").Select
'Range("A2").Activate
With Worksheets("Test Model")
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("R2:R125"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1:AO125")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'.Activate ' <-- not sure why it's needed
'.Range("C7").Select ' <-- not sure why it's needed
End With
End Sub
I'm currently trying to self-teach myself VBA code in Excel, but I've run into a problem.
What I'm wanting Excel to do is to automatically order specific rows according to the date entered in specific cells. For example, dates will be entered into cells E36-E40 only, and as they are entered rows 36-40 (not including column A) will automatically sort themselves according to the oldest date first.
I've done a macro recording of this and it has spat out this code:
Sub AutoSort()
Range("B36:H40").Select
ActiveWorkbook.Worksheets("SHEET NAME").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SHEET NAME").Sort.SortFields.Add Key:=Range( _
"E37:E40"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("SHEET NAME").Sort
.SetRange Range("B36:H40")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
I've tried to make this automatic as shown below, however does not work!
Sub Worksheet_Change1(ByVal Target As Range)
If Intersect(Target, Range("E36, E37, E38, E39, E40")) Is Nothing Then
Exit Sub
Else
Sub AutoSort()
Range("B36:H40").Select
ActiveWorkbook.Worksheets("SHEET NAME").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SHEET NAME").Sort.SortFields.Add Key:=Range( _
"E37:E40"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("SHEET NAME").Sort
.SetRange Range("B36:H40")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End Sub
End Sub
Any help would be greatly appreciated!
MSDN definition of Me: Provides a way to refer to the specific instance of a class or structure in which the code is currently executing.
I used Me instead of ActiveWorkbook.Worksheets("SHEET NAME") because this code is only relevant to the worksheet that calls the event. I originally used ActiveSheet but if a Macro changed the values from a different worksheet than that worksheet would be active and it would be sorted.
Turn off EnableEvents, whenever changing values on the ActiveSheet from the Worksheet_Change event. This will prevent the Worksheet_Change event from triggering itself causing an infinite loop and crashing Excel.
Include an Error Handler that will turn the events back on, if an error is thrown.
The key range started at row 37
.Header = xlYes should be .Header = xlNo
Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo ResumeEvents
If Not Intersect(Target, Range("E36:E40")) Is Nothing Then
With Me
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("E36:E40"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("B36:H40")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End If
ResumeEvents:
Application.EnableEvents = True
End Sub
using Sort() method of Range leads to a more concise code:
Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo ErrHandler
If Not Intersect(Target, Range("E36:E40")) Is Nothing Then _
Range("B36:H40").Sort key1:=Range("E36"), order1:=xlAscending, Header:=xlNo, SortMethod:=xlPinYin, DataOption1:=xlSortNormal, MatchCase:=False, Orientation:=xlTopToBottom
ErrHandler:
Application.EnableEvents = True
End Sub
or, encapsulating the sorting operation into a specific sub:
Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E36:E40")) Is Nothing Then AutoSort Range("B36:H40"), Range("E36")
End Sub
Sub AutoSort(dataRng As Range, orderCol As Range)
Application.EnableEvents = False
On Error GoTo ErrHandler
dataRng.Sort key1:=orderCol, order1:=xlAscending, Header:=xlNo, SortMethod:=xlPinYin, DataOption1:=xlSortNormal, MatchCase:=False, Orientation:=xlTopToBottom
ErrHandler:
Application.EnableEvents = True
End Sub
Don't encapsulate your Subprocedure AutoSort() in your other procedure. Put your AutoSort() procedure in module, then call it within worksheet code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E36, E37, E38, E39, E40")) Is Nothing Then
Exit Sub
Else
AutoSort
End If
End Sub
Also, change .Header = xlYes to .Header = xlNo if Row 36 doesn't contain header.
I'm trying to write a macro to Auto Sort a table in Excel when any value in the table is changed.
This is my VBA code
Sub Macro3(ByVal target As Range)
ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table4").sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table4").sort.SortFields.Add _
Key:=Range("Table4[Pts]"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table4").sort.SortFields.Add _
Key:=Range("Table4[GD]"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table4").sort.SortFields.Add _
Key:=Range("Table4[GF]"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table4").sort
.Header = xlYes
.MatchCase = True
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub sort()
Dim target As Range
Set target = Range("Table4")
Call Macro3(target)
End Sub
What should I do to let this macro run continuously each time values in the table change?
A Worksheet_Change event macro will not be triggered when cell values are changed due to a cell's formula recalculating from a change in another worksheet. You need to capture the Worksheet_Calculate event for that.
This is not module code. It belongs on Sheet1's code page. Right-click the Sheet1 tab at the bottom of your workbook and choose View Code. When the VBE opens, paste the following into the into the pane titled something like Book1 - Sheet1 (Code).
Private Sub Worksheet_Calculate()
On Error Goto bm_Safe_Exit
Application.EnableEvents = False
With ListObjects("Table4").Sort
With .SortFields
.Clear
.Add Key:=Range("Table4[[#All],[Pts]]"), Order:=xlDescending
.Add Key:=Range("Table4[[#All],[GD]]"), Order:=xlDescending
.Add Key:=Range("Table4[[#All],[GF]]"), Order:=xlDescending
End With
.Header = xlYes
.Apply
End With
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
Tap Alt+Q to return to your worksheet. If the formulas recalculate, the data in Table4 will be resorted. Events monitoring is temporarily suspended so that the act of sorting does not trigger another calculation event.
To have a macro run every time a cell in a table / range changes, you can use events, which you put in the code for the sheet.
In your case, you probably want something like:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, range_of_table) Is Nothing Then
Call sort
End If
End Sub
Where range_of_table is the range of the table you've created.
I'm trying to pass a range to a subroutine, but its throwing up a "Method 'Range' of object '_Global' failed" error.
In the main I declare and define the range variable I want to use:
Sub maintest()
Dim ScheduledSort As Range
Set ScheduledSort = Range("F4:F321")
Call test(ScheduledSort)
End Sub
Then in the subroutine test I want it to sort using the range I passed it from the routine above:
Sub test(RangeForSort)
Sheets("SheetTest").Select
' Sort in descending order
ActiveWorkbook.Worksheets("SheetTest").AutoFilter.Sort.SortFields.Add _
Key:=Range("RangeForSort"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("SheetTest").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
I think its going wrong at the Key:=Range("RangeForSort") but I can't work out why and how to fix it.
What is it I'm doing wrong with the Range and how do I fix it such that I can pass it any Range to sort on?
And if you have a better suggestion for what I'm trying to do, feel free to add! :-)
Shorter version would look like this:
Sub test(rng As Range)
' Sort in descending order
Worksheets(rng.Parent.Name).AutoFilter.Sort.SortFields.Add _
Key:=rng, SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortTextAsNumbers
With Worksheets(rng.Parent.Name).AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
To run:
Call test(Worksheets("YOUR WORKSHEET NAME").Range("YOUR RANGE")).
If you pass a Range object to the sub, you are passing an object that is already associated with some worksheet. The sub selects a potentially different worksheet and then has trouble handling the passed range.
If you want to pass a specific block of cells to a sub that needs to change worksheets, then pass a String variable instead.
UNTESTED
Sub maintest()
Dim ScheduledSort As String
ScheduledSort = "F4:F321"
Call test(ScheduledSort)
End Sub
Sub test(RangeForSort As String)
Sheets("SheetTest").Select
ActiveWorkbook.Worksheets("SheetTest").AutoFilter.Sort.SortFields.Add _
Key:=Range(RangeForSort), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("SheetTest").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
I set this up and now I can pass the "ActiveCell/Range" whatever and call the function throughout my project if needed.
Public colLetter As Variant
Sub Test()
Dim rng As Range
Set rng = ActiveWorkbook.ActiveSheet.Range("A1:A1")
Call GetColLet(rng)
End Sub
Public Sub GetColLet(var As Range)
colLetter = Split(var.Address, "$")(1)
MsgBox colLetter
End Sub