I don't know where I am going wrong but it not working neither giving any error. I am trying to Update my Pivot table with cell values that should filter the given date ranges in cell G3 & G4. But unfortunately not updating the table.
Below is the VBA I am using.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'This line stops the worksheet updating on every change, it only updates when cell
'G3 or G4 is touched
If Intersect(Target, Range("G3:G4")) Is Nothing Then Exit Sub
'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim EDate As String
Dim SDate As String
'Here you amend to suit your data
Set pt = Worksheets("Report").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Date")
SDate = Worksheets("Report").Range("G3").Value
EDate = Worksheets("Report").Range("G4").Value
'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters
Field.PivotFilters.Add Type:=xlDateBetween, Value1:=SDate, Value2:=EDate
pt.RefreshTable
End Sub
I was able to resolve it myself. Posting the answer below, might be of someone's help.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'This line stops the worksheet updating on every change, it only updates when cell
'G3 or G4 is touched
If Intersect(Target, Range("G3:G4")) Is Nothing Then Exit Sub
'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim EDate As String
Dim SDate As String
'Here you amend to suit your data
Set pt = Worksheets("Report").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Date")
SDate = Worksheets("Report").Range("G3").Value
EDate = Worksheets("Report").Range("G4").Value
'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters
Field.PivotFilters.Add Type:=xlDateBetween, Value1:=SDate, Value2:=EDate
pt.RefreshTable
End With
End Sub
Related
I have a budget template with tables for each budget category. I have buttons for users to add rows to each budget category with the rows in each category being set as a table so that my total functions work no matter how many rows are added where. But Id like users to also be able to delete rows like if they add too many or if roles change during the time the budget is changed, etc. I don't want users to be able to delete rows such as headers or totals. Protecting the rows doesn't work since the row number can change at any time with new rows being added at any time. The delete selected row code is below as well as my add a row code for the first category which is full time employee salary.
delete selected row - not good since can delete important rows
Sub DeleteSelectedRow()
Rows(ActiveCell.Row).Delete
End Sub
add row to category - good since adds rows to table to keep formulas working
Sub AddConsultant()
Dim ws As Worksheet
Dim tbl As ListObject
Set ws = ActiveSheet
Set tbl = ws.ListObjects("Consultants")
tbl.ListRows.Add
End Sub
Try this:
Sub AddConsultant()
Dim ws As Worksheet
Dim tbl As ListObject
Set ws = ActiveSheet
Set tbl = ws.ListObjects("Consultants")
tbl.ListRows.Add
End Sub
Sub DeleteSelectedRow()
Dim ws As Worksheet
Dim tbl As Range
Set ws = ActiveSheet
Set tbl = ws.ListObjects("Consultants").Range
If InRange(ActiveCell, tbl) Then
Rows(ActiveCell.Row).Delete
Else
MsgBox ("Cannot Delete")
End If
End Sub
Function InRange(Range1 As Range, Range2 As Range) As Boolean
' returns True if Range1 is within Range2
Dim InterSectRange As Range
Set InterSectRange = Application.Intersect(Range1, Range2)
InRange = Not InterSectRange Is Nothing
Set InterSectRange = Nothing
End Function
You can check whether the selection (or part of the selection) range is inside the table of interest.
For example:
Sub AddConsultant()
AddRow "Consultants"
End Sub
Sub RemoveConsultant()
RemoveSelectedRow "Consultants"
End Sub
Sub AddSite()
AddRow "Sites"
End Sub
Sub RemoveSite()
RemoveSelectedRow "Sites"
End Sub
'methods to add/remove rows from the specified table
Sub AddRow(tableName As String)
ActiveSheet.ListObjects(tableName).ListRows.Add
End Sub
Sub RemoveSelectedRow(tableName As String)
Dim rng As Range, ok As Boolean
If TypeName(Selection) = "Range" Then 'is a range selected?
'is the range in the required table?
Set rng = Application.Intersect( _
ActiveSheet.ListObjects(tableName).DataBodyRange, Selection)
If Not rng Is Nothing Then
rng.EntireRow.Delete
ok = True
End If
End If
'didn't delete anything?
If Not ok Then MsgBox "First select one or more rows in " & _
tableName & " table"
End Sub
I have an Excel dashboard that updates tables and charts when the name and dates are changed in specific cells, but I also need 2 pivot tables to update using these cells too.
My name cell is D2:G2 and my date range cells are From: P2 To: R2
I've tried various solutions found on the net for updating pivot date ranges but none of them work when trying to link them with the name update code.
So far I have:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim PTable As PivotTable
Dim PField As PivotField
Dim Str As String
On Error Resume Next
If Intersect(Target, Range("D2:G2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set PTable = Worksheets("Stats").PivotTables("PivotTable1")
Set PField = PTable.PivotFields("BM attendees")
Str = Target.Text
PField.ClearAllFilters
PField.CurrentPage = Str
Application.ScreenUpdating = True
End Sub
I have some working VBA to update one of the pivots when the name is changed, but I need both pivots to update, and also need the dates on both pivots to update based on the date range.
If anyone can help with the VBA to get this working it would be greatly appreciated.
Here is an example for 1 pivottable to demonstrate how to select pivotitems within filters (= PageFields) of a pivot table. As you can not set a date range on a pagefield, you need to switch each corresponding pivot item visible or not.
You always have to ensure, that at least 1 pivotitem remains visible.
You also have to ensure, that the given attendee name (in Target.Text) corresponds to any pivot item, before you try to switch the currentpage to that attendee.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim PTable As PivotTable
Dim PField As PivotField
Dim PItem As PivotItem
Dim AttendeeName As Range
Dim DateFrom As Range, DateTo As Range
Dim AtLeastItemRemainsVisible As Boolean
Set AttendeeName = ActiveSheet.Range("D2")
Set DateFrom = ActiveSheet.Range("D2")
Set DateTo = ActiveSheet.Range("R2")
Set PTable = Worksheets("Stats").PivotTables(1) ' or ("PivotTable1")
Application.ScreenUpdating = False
'Application.EnableEvents = False
' Select 1 attendee name as single filter page:
If Not Intersect(Target, AttendeeName) Is Nothing Then
Set PField = PTable.PageFields(1) ' or ("BM attendees")
PField.ClearAllFilters
PField.EnableMultiplePageItems = False
For Each PItem In PField.PivotItems
If PItem.Name = Target.Text Then
PField.CurrentPage = Target.Text
End If
Next PItem
' select all valid dates between two given dates:
ElseIf Not Intersect(Target, Union(DateFrom, DateTo)) Is Nothing Then
Set PField = PTable.PageFields(2)
PField.ClearAllFilters
PField.EnableMultiplePageItems = True
' at least 1 PivotItem must remain visible:
AtLeastItemRemainsVisible = False
For Each PItem In PField.PivotItems
If CDate(PItem.Name) >= CDate(DateFrom) _
And CDate(PItem.Name) <= CDate(DateTo) Then
AtLeastItemRemainsVisible = True
Exit For
End If
Next PItem
If AtLeastItemRemainsVisible Then
For Each PItem In PField.PivotItems
PItem.Visible = _
CDate(PItem.Name) >= CDate(DateFrom) _
And CDate(PItem.Name) <= CDate(DateTo)
Next PItem
End If
End If
'Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Separate story: I suggest to use a date filter on a corresponding rowfield or columnfield instead of using dates as PageField. Be aware that you have to convert date values into strings to use it with such a PivotFilter. Here's a general example:
Private Sub DateFilter()
With ActiveSheet.PivotTables(1).RowFields(1)
.ClearAllFilters
' between two dates:
.PivotFilters.Add2 _
Type:=xlDateBetween, _
Value1:=CStr(DateSerial(Year(Date) - 1, Month(Date), Day(Date))), _
Value2:=CStr(Date), _
WholeDayFilter:=True
' another example, please refer to macro recorder for special date ranges:
.PivotFilters.Add2 _
Type:=xlDateThisYear
End With
End Sub
I am setting up a dynamic report and would like to filter multiple pivot tables at the same time as I change one cell value. I have no experience in VBA and cannot find anyone within my company that can help.
Since the pivot tables are separate objects, I define them all as different dimensions and point these dimensions to the different pivot tables but the cell that is meant to dictate the pivot table filter stays the same. Below are modified from my google search. Original codes worked fine updating 1 pivot table. After my ignorant attempt at modifying the codes, I ended up with application-defined or object-defined error.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("D1:D2")) Is Nothing Then Exit Sub
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String
Dim pt1 As PivotTable
Dim Field1 As PivotField
Dim NewCat1 As String
Set pt = Worksheets("Sheet1").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Code")
NewCat = Worksheets("Sheet1").Range("D1").Value
Set pt1 = Worksheets("Sheet1").PivotTables("Pivotable2")
Set Field1 = pt1.PivotFields("Code")
NewCat1 = Worksheets("Sheet1").Range("D1").Value
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
pt.RefreshTable
End With
With pt1
Field1.ClearAllFilters
Field1.CurrentPage = NewCat1
pt1.RefreshTable
End With
End Sub
I need assistance with selecting a Pivot table range to copy into another spreadsheet. What I need to do is copy all the rows and columns for a specific "Project WBS" value that will be searched on.
In my code below I tried using xlDataAndLabel but it only gives me the Project WBS and Pivot Items I need. It leaves out the "Description", "Employee", and "Activity Type" columns. I can't use .EntireRow.Copy because when I go to the other workbook to paste I get an error saying the size is too great.
Your help is greatly appreciated.
Max
Sub getPivotData()
Dim PvtTbl As PivotTable
Set PvtTbl = Worksheets("Aug 18 Report").PivotTables("PivotTable1")
Worksheets("Aug 18 Report").Activate
Application.PivotTableSelection = True
PvtTbl.PivotSelect "GS136.548", xlDataAndLabel
Selection.Interior.Color = vbYellow
End Sub
You could try resizing the target label range to the number of columns in the pivottable
e.g.
Option Explicit
Public Sub test()
Dim pvt As PivotTable, rng As Range
Set pvt = ActiveSheet.PivotTables(1)
With pvt.PivotFields("Project WBS").PivotItems("A").LabelRange
Set rng = Worksheets(pvt.Parent.Name).Range(.Resize(.Rows.Count, pvt.TableRange1.Columns.Count).Address)
Debug.Print rng.Address
End With
End Sub
In the following the highlighted area is the address returned by the print statement
Here is an example of referencing the pivot if it is in a different (open) workbook:
Option Explicit
Public Sub test()
Dim pvt As PivotTable, rng As Range
Dim wb As Workbook, ws As Worksheet
Set wb = Workbooks("Book3.xlsb")
Set ws = wb.Worksheets("Sheet1")
Set pvt = ws.PivotTables(1)
With pvt.PivotFields("Project WBS").PivotItems("A").LabelRange
Set rng = ws.Range(.Resize(.Rows.Count, pvt.TableRange1.Columns.Count).Address)
Debug.Print rng.Address
End With
End Sub
I've tried many changes but can't make this work... Help plz :)
I want to change a pivot table filter according to a cell range.
Creating the sub inside the proper sheet (Graficos). Have tried renaming it to "Sheet6" and also the code.
Pivot Table Field: "Customer"
Pivot Table Name: "sellin"
Sheet: "Grafico"
Error 1004 on line 21: Field.CurrentPage = NewCat
Application-defined or object-defined error
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("F1:F2")) Is Nothing Then Exit Sub
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String
Set pt = Worksheets("Grafico").PivotTables("sellin")
Set Field = pt.PivotFields("Customer")
NewCat = Worksheets("Grafico").Range("F1").Value
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
pt.RefreshTable
End With
End Sub
Make sure that cell F1 has a value and that that value is one of the customer names. Then the code runs fine.