I have inserted a command button on a worksheet that when pressed opens a password userform. when a password is entered this puts the cost centre number into a worksheet Executive Summary.
The code below does not automatically update the pivot table as it requires the target cell to be changed.
How can I change the following code to update every time the target cell changes?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'This line stops the worksheet updating on every change, it only updates
'when cell G1 is touched
If Not Intersect(Target, Range("G1")) Is Nothing Then Exit Sub
'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String
'Here you amend to suit your data
Set pt = Worksheets("Executive Summary").PivotTables("ServiceCostAnalysis")
Set Field = pt.PivotFields("Cost Centre")
NewCat = Worksheets("Executive Summary").Range("G1").Value
'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
pt.RefreshTable
End With
End Sub
Thanks
Just take Worksheet_Change instead of Worksheet_SelectionChange:
Private Sub Worksheet_Change(ByVal Target As Range)
This procedure executes every time a Cell in the Worksheet is changed.
Related
I'm a novice VBA user and already posted on this issue, but had to re-do some tables in my workbook and the initial question ended up being inaccurate, hence trying again.
I have modified a code found online to work with my workbook which:
links a cell to a my pivot table filter;
updates the filter and refreshes pivot table once the cell has been updated or activated;
Works great. The challange is that there are 2 pivot tables on the same worksheet and I'd need to filter 2 tables at the same time. Also the filter data is different, so the filter should be linked to different cells, although they do change at the same time.
The code I was using is below. Now there is PivotTable1 and PivotTable2; entry to cell H6 is linked to the 1st table and H7 to the other table. Got a little overwhelmed at this point, but this should be possible within the same code, right?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'This line stops the worksheet updating on every change, it only updates when cell
'H6 or H7 is touched
If Intersect(Target, Range("H6:H7")) Is Nothing Then Exit Sub
'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String
'Here you amend to suit your data
Set pt = Worksheets("Sheet1").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Category")
NewCat = Worksheets("Sheet1").Range("H6").Value
'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
pt.RefreshTable
End With
End Sub
Your code can be amended as follows...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'This line stops the worksheet updating on every change, it only updates when cell
'H6 or H7 is touched
If Intersect(Target, Range("H6:H7")) Is Nothing Then Exit Sub
'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim vPivotTableNames As Variant
Dim vNewCats As Variant
Dim i As Long
'Assign the pivottable names to a variable
vPivotTableNames = Array("PivotTable1", "PivotTable2")
'Assign the new categories to a variable
vNewCats = Range("H6:H7").Value
'Update the pivotables
For i = LBound(vPivotTableNames) To UBound(vPivotTableNames)
Set pt = Worksheets("Sheet1").PivotTables(vPivotTableNames(i))
Set Field = pt.PivotFields("Category")
With Field
.ClearAllFilters
.CurrentPage = vNewCats(i + 1, 1)
End With
pt.RefreshTable
Next i
End Sub
Although, the For/Next loop can be re-written as follows...
'Update the pivotables
For i = LBound(vPivotTableNames) To UBound(vPivotTableNames)
With Worksheets("Sheet1").PivotTables(vPivotTableNames(i))
With .PivotFields("Category")
.ClearAllFilters
.CurrentPage = vNewCats(i + 1, 1)
End With
.RefreshTable
End With
Next i
I have a pivot table in sheet 2. The pivot table filter will automatically change each time I change the value in sheet 1 cell D1. However, the table only refreshes when I go back to sheet 2 and click anywhere on screen. How can I get this to change automatically?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String
'Set worksheet and cell
Set pt = Worksheets("Sheet2").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Sum1")
NewCat = Worksheets("Sheet1").Range("D1").Value
'Update and refresh
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
pt.Update
End With
End Sub
Note: I have also tried pt.Refresh and pt.RefreshTable
I have a conditional formatting rule defined as macro, which deletes the old rules and replaces them with updates ones:
Sub setCondFormat()
Set Table = ActiveSheet.ListObjects("Rules")
Table.Range.FormatConditions.Delete
Set Attribute = Table.ListColumns("Attribute")
With Attribute.DataBodyRange.FormatConditions _
.Add(xlExpression, xlEqual, "=ISEMPTY(A2)")
With .Interior
.ColorIndex = 0
End With
End With
End Sub
The conditional formatting in Excel needs to be updated. Otherwise the
cell ranges in the rules get fragmented.
Let's say you have two rules:
Make $A$1:$A$30 red
Make $B$1:$B$30 blue Now select A10:B10 and copy/paste that to A20:B20.
What Excel will do is to delete the conditional formatting.
For A20:B20 from the rules that applied to those cells and add new
rules that have the formatting for A20:B20. You end up with four
rules:
Make =$A$20 red
Make =$B$20 blue
Make =$A$1:$A$19,$A$21:$A$30 red
Make =$B$1:$B$19,$B$21:$B$30 blue
This happens, when the table structure gets changed through cut/paste/delete/insert events.
How to trigger the above VBA macro on cut/paste/delete/insert events?
You could use a shortcut for your macro
VBA event trigger on copy?
If you don't want to go this way you'll need to use the Windows API:
Is there any event that fires when keys are pressed when editing a cell?
The solution I found is create a new Sheet with the content of your table when you open the Workbook. First you need to create a Module with the Public Variables.
Public OldRange As Range
Public NewRange As Range
Public Table As ListObject
Then, use the event Open of your Workbook.
Private Sub Workbook_Open()
Dim sh As Worksheet
Dim address As String
For Each sh In Worksheets
If sh.Name = "DATA" Then
Worksheets("DATA").Activate
ActiveSheet.Delete
End If
Next
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "DATA"
Set sh = ActiveWorkbook.Sheets("Plan1")
sh.Activate
Set Table = ActiveSheet.ListObjects("Rules")
Set OldRange = Table.Range
address = Table.Range.address
Table.Range.Copy
Set sh = ActiveWorkbook.Sheets("DATA")
sh.Activate
Range(address).PasteSpecial (xlPasteAll)
End Sub
And then, use the event Worksheet_Change to verify the content of your original table with the earlier saved table.
Private Sub Worksheet_Change(ByVal Target As Range)
Set Table = ActiveSheet.ListObjects("Rules")
If Intersect(Target, Table.Range) Is Nothing Then Exit Sub 'this will guarantee that the change made in your sheet is in your desired table
Set NewRange = Table.Range
Dim rng As Range
Dim rngaddr As String
Dim TableChanged As Boolean
TableChanged = False
For Each rng In NewRange
rngaddr = rng.address
If rng.Value <> ActiveWorkbook.Sheets("DATA").Range(rngaddr).Value Then
'do something
TableChanged = True
End If
Next
End Sub
Remember: you need to save the content of your table every time you changed it.
Can any one see why this isn't working for me?
My cell H6 contains a 12 digit number, thus the use of Long.
Any thoughts on how to adjust this code in order for it to work:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'This line stops the worksheet updating on every change, it only updates when cell'H6 or H7 is touched
If Intersect(Target, Range("H6:H7")) Is Nothing Then Exit Sub
'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As Long
'Here you amend to suit your data
Set pt = Worksheets("Data1").PivotTables("PivotTable10")
Set Field = pt.PivotFields("[Produkter].[EAN].[EanID]")
NewCat = Worksheets("Data1").Range("H6").Value
'This updates and refreshes the PIVOT table
With ActiveSheet.PivotTables("PivotTabel10").PivotFields("[Produkter].[EAN].[EanID]")
.ClearAllFilters
.PivotFilters.Add Type:=xlCaptionEquals, Value1:=ActiveSheet.Range("H6").Value
End With
Long is only 32 bits so you can only store 9 decimal digits. Use Double or (only if you have a 64bit-version) LongLong.
I'm trying to set up Excel so that the cell's value that is selected in the first worksheet is set to the value of a cell that's double clicked in a different worksheet. So far my code looks like this:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Range
For Each c In Sheet1.Range("M11:M24")
If IsEmpty(c) Then
c.Value = Target.Value
Exit For
End If
Next c
End Sub
What this does is sets the first empty cell in the range m11:m24 to the contents of the double clicked cell in the other worksheet. What I want though is not a static "M11:M24" range, but instead have the user select a cell in the first worksheet by clicking on it, move to the other worksheet, double click a cell in that worksheet and have the value appear in the selected cell on the first worksheet. I think I could have it so that there is a variable set up to save which cell is selected in the first worksheet and then just access that from the other worksheet. But I'd prefer if there was away built in to Excel to just choose the selected cell.
Is there a way to get the selected cell/range in Excel?
I solved this easily. The code is:
Sheet1.Activate
ActiveCell.Value = Target.Value
If you want to do a whole selection, try
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Sheet1.Activate
Dim r As Range
Set r = Selection
r.Value = Target.Value
End Sub