My goal is to change the filter of 3 pivot tables, all with the same field with the click of a button attached to a macro.
Here is my code:
Dim pickedDate As String
Dim shift As String
pickedDate = Worksheets("Report").Range("C1").Value
shift = Worksheets("Report").Range("C2").Value
Worksheets("Report").PivotTables("PivotTable2").PivotCache.SourceData = Worksheets("Fullness").Range("A1").CurrentRegion.Address(, , xlR1C1, True)
Worksheets("Report").PivotTables("PivotTable3").PivotCache.SourceData = Worksheets("Backed").Range("A1").CurrentRegion.Address(, , xlR1C1, True)
Worksheets("Report").PivotTables("PivotTable4").PivotCache.SourceData = Worksheets("Hoist").Range("A1").CurrentRegion.Address(, , xlR1C1, True)
For Each PT In ActiveSheet.PivotTables
PT.PivotFields("Date").CurrentPage = CDate(pickedDate)
PT.PivotFields("Shift").CurrentPage = shift
Next
However when I get to my loop for the pivot tables, I get the error on PT.PivotFields("Date").CurrentPage = CDate(pickedDate)
:
Run time error 1004
Application Defined or Object Defined Error
I've verfied the source data for the tables is updated correctly.
I've tried not using the loop, and doing it manually like
Worksheets("Report").PivotTables("PivotTable4").PivotFields("Date").CurrentPage = CDate(pickedDate)
for each table, and it only works for one of the tables, my PivotTable3.
Even more curiously, when I comment out my code to change the date, and use either way (the loop or the manual change for the 3 tables) for the shift change it works perfectly with no error.
I've verfied the name of my pivot tables, that's not the issue. The name of the field I'm trying to change appears correct as well- it works for one of the tables and I've copied and pasted that cell "Date" into the others even.
What am I missing?
I'm not completely sure why this works now, but all I did to change my code was add into the loop a clear filter command for the "Date" field.
So now my code has this loop instead for making the date and shift change for all the pivot tables based on a cell value I enter manually, just once
For Each PT In ActiveSheet.PivotTables
PT.PivotFields("Date").ClearAllFilters
PT.PivotFields("Date").CurrentPage = CDate(pickedDate)
PT.PivotFields("Shift").CurrentPage = shift
Next
Again, I'm not sure why I didn't have to do this for the shift filter, but now it works. I suggest trying that first if anyone encounters this issue
Related
Basically I made a macro which does a few copy-paste, and change the filter on the pivot table. Now, there are quite a few pivots, with the same filter to be changed (a date), so I want to make a variable for them.
So the macro works without variables, but when I put:
Dim x,y as Date
x = "2020/9/1"
y = 2020/8/20"
And then put it into the pivot name -I cant copy the full code, nor the parts, because they are on virtual deskop for work.
Activesheet.PivotTables("pivottable3").PivotSelect "'2020/9/1' text" _
xlDataAndLabel, True
and I changed this to:
Activesheet.PivotTables("pivottable3").PivotSelect "'x' text" _
xlDataAndLabel, True
and I get an error saying this name doesn't exist. What did I do wrong?
I am trying to compare spending data from two sources: a curated manual input from users and an automated extract, for different business units. The common data from both sources is the ID of the spending.
The idea is to aggregate both data sources (excel Tables) into one Table where the first two columns are the ID of the spending, the next column is the spending data from users related to that ID and the last one is the spending data from automated extract.
In this table, I'll have "double" the total spending for each ID, but then I can do a pivot table where I'll clearly compare the users input with the automated extract for each ID.
I highlighted the important fields I need to copy and paste.
[![PGIvsManual][3]][3]
My code is the following
Sub PGIvsManualInput()
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set PGIvsManualTable = Worksheets("PGI vs Dépenses (Auto)").ListObjects("PGIvsManualInputAuto")
Set PGITable = Worksheets("PGI Clean").ListObjects("PGIExtract")
Set ManualInputTable = Worksheets("Dépenses").ListObjects("Dépenses")
'Cleaning the table
With Worksheets("PGI vs Dépenses (Auto)").Range("PGIvsManualInputAuto")
.ClearContents
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With PGIvsManualTable
If .ListRows.Count >= 1 Then
.DataBodyRange.Rows.Delete
End If
End With
'Copy the data
PGITable.ListColumns(1).DataBodyRange.Resize(, 2).Copy Destination:= _
PGIvsManualTable
Ant that's where it gets messy. I can't even get the first batch of data to properly import! I am trying to copy the 2 first columns from PGITable and paste them in the 2 first columns of PGIvsManualTable. This worked previously without defining any destination column in my first example, even though both the input and destination Tables didn't have the same number of columns
But in this case, it extends the pasting to all columns of my destination table! I don't understand this comportment as it doesn't happen on my previous example with basically the exact same code!!
I tried to set the destination as follows but always got errors:
PGIvsManualTable.ListColumns(1).DataBodyRange.Resize(, 2) ==> Error 91
PGIvsManualTable.DataBodyRange(1,1) ==> Error 438
PGIvsManualTable.ListColumns(1).Resize(, 2) ==> Error 438
And a few others, but it never worked properly.
I expect the output to be my selected columns copy/pasted properly in my destination column, based on the coordinates I provide in the ListObecjts.DataBodyRange.
I guess that if I manage to make this first import work, all other will work on the same template, but in the meantime, my code seem to work on the previous example.
Deletion of the DataBodyRange.Rows will cause an issue if you then try to paste into the DataBodyRange.
As a workaround, you could delete all rows after the first, something like this example:
Sub Test()
Dim firstTbl As ListObject, secondTbl As ListObject
Set firstTbl = Sheet1.ListObjects("Table1")
Set secondTbl = Sheet1.ListObjects("Table2")
With secondTbl
.DataBodyRange.Clear
If .ListRows.Count > 1 Then
.DataBodyRange.Offset(1).Resize(.ListRows.Count - 1).Rows.Delete
End If
End With
firstTbl.ListColumns(1).DataBodyRange.Resize(, 2).Copy secondTbl.DataBodyRange(1, 1)
End Sub
I have a VBA form which is used to enter data on a sheet. I am currently coding the form so as it will load any data already existing in the sheet back into the form.
For simple text strings it works perfectly.
e.g.
ReqSetup.ReqText = Application.Worksheets("Req Sheet").Range("F11").Value
However, I have some combo boxes, that on the form, when they are selected will enter a number in the corresponding cell.
Fail 1. - Run Time Error 380 - Invalid property value.
ReqSetup.MinPerKgCB = Application.Worksheets("Req Sheet").Range("C27").Value
Fail 2.
Dim MinPerKg As Range
Set MinPerKg = Application.Worksheets("Req Sheet").Range("C27")
ReqSetup.MinPerKgCB = MinPerKg
I'm obviously doing something really simple wrong but I can't work out what it is!!
Kind Regards!
I have some combo boxes, that on the form, when they are selected will
enter a number in the corresponding cell
Then you'd need to do the opposite of your code attempt, i.e.:
Worksheets("Req Sheet").Range("C27").Value = ReqSetup.MinPerKgCB.Value
That you'd better wrap inside a check that any combobox value is actually selected :
With ReqSetup.MinPerKgCB
If .ListIndex <> -1 Then Worksheets("Req Sheet").Range("C27").Value = .Value
End With
Okay, so I have a pivot table where there is a column of provinces and other columns of sales per years.
I have created macros through vba to apply filtering on the pivot table.
(Recorded macros)
I want to add all available label and value filters into a listbox eg:
Label filters are :
Equals...
Does not equal...
Begins with...
Etc...
I want all of them in a listbox, or combobox, or anything the user can click and expand to select what filter they want.
Any help please?
jamesalainheffer#gmail.com
Okay well I seemed to have figured it out. Most people don't know about the filtering options in excel. And if they do, they probably would go about doing it in VBA by saying something like
`With
ActiveSheet.PivotTables("pvt_Data").PivotFields("Province")`
.PivotItems("Yukon").Visible = false
and so on... By just making the field or item not visible, doesn't neccessarily mean you're applying a filter to anything...
So, here's what I found...
dim prov as string
dim letter as string
dim val2 as string
dim pvtPivotTable as PivotTable
dim pfdValueField as PivotField
dim pfdTRowField as PivotField
set pvtPivotTable = ActiveSheet.PivotTables("pvt_Data")
set pfdValueField = ActiveSheet.PivotTables("Sum of Sales")
set pfdTRowField = pvtPivotTable.PivotFields("Province")
letter = TextBox4.Value
prov = TextBox1.Value
msg = ", Caption Filters, " & listbox1.value
with pvtPivotTable
.AllowMultipleFilters = True
pfdTRowField.PivotFilters.Add2 Type:=Listbox1.Value, Value1:=prove, Value2:=letter
end with
set pfdValueField = nothing
set pfdRowField = nothing
filterlistbox.AddItem(Listbox1.Text & " " & prov & msg
now what this does along with the rest of my projects is it loads every xlFilterType into 3 listboxes, per categpry of Caption filters (text), Value Filters (numerical), and date filter (date)
3 listbox's for 3 categories of filter types, each listbox is loaded with them (filter types [xlBefore, xlCaptionIsEqual]) when you select a filter type, enter a value into a textbox and push a button and it weill then apply that filter onto my pivot table.
The listbox where the filter type gets added I did like this:
.addItem("Equall...")
.list(0, 1) = "15"
What this does is add that "Equall" to the list box, the list statement just inserts 15 into the 2nd column on the 1 st index (index starts at 0, 1 is the 2nd column)
Now, the xlFilterTypes have a value as well as a name for example XlCaptionEqualls is the name and its value is 15, the listbox1.value is this value becuase i set the bound column to number 2, so the listbox pushes out the filterTypes value (number) instead of the text I hard coded, you can then use case statements to get the name from the value and insert them into another listbox.
this is a bit all over the show but I would like to know if nayone has managed to add multiple filters onto their pivot table using vba? and the add2 method?
Kick ass.
I have a dataset with 60+ thousand rows in excel and about 20 columns. The "ID column" sometimes repeats itself and I want to add a column that will return 1 only in the row that is the most recent only IF it repeats itself.
Here is the example. I have…
ID DATE ColumnX
AS1 Jan-2013 DATA
AS2 Feb-2013 DATA
AS3 Jan-2013 DATA
AS4 Dec-2013 DATA
AS2 Dec-2013 DATA
I want…
ID DATE ColumnX New Column
AS1 Jan-2013 DATA 1
AS2 Feb-2013 DATA 0
AS3 Jan-2013 DATA 1
AS4 Dec-2013 DATA 1
AS2 Dec-2013 DATA 1
I've been trying with a combination of sort and nested if's, but it depends on my data being always in the same order (so that it looks up the ID in the previous row).
Bonus points: consider my dataset if fairly large for excel, so the most efficient code that won't eat up processor would be appreciated!
An approach you could use is to point MSQuery at your table and use SQL to apply the business rules. On the positive side, this runs very quickly (a couple seconds in my tests against 64k rows). A huge minus is the query engine does not seem to support Excel tables exceeding 64k rows, but there might be ways to work around this. Regardless, I offer the solution in case it gives you some ideas.
To set up first give your data set a named range. I called it MYTABLE. Save. Next select a cell to the right of your table in row 1, and click through Data | From other sources | from Microsoft Query. Choose Excel Files* | OK, browse for your file. The Query Wiz should open, showing MYTABLE available, add all the columns. Click Cancel (really), and click Yes, you want to continue editing.
The MSQuery interface should open, click the SQL button and replace the code with the following. You will need to edit some specifics, such as the file path. (Also, note I used different column names. This was sheer paranoia on my part. The Jet engine is very finicky and I wanted to rule out conflicts with reserved words as I built this.)
SELECT
MYTABLE.ID_X,
MYTABLE.DATE_X,
MYTABLE.COLUMN_X,
IIF(MAXDATES.ID_x IS NULL,0,1) * IIF(DUPTABLE.ID_X IS NULL,0,1) AS NEW_DATA
FROM ((`C:\Users\andy3h\Desktop\SOTEST1.xlsx`.MYTABLE MYTABLE
LEFT OUTER JOIN (
SELECT MYTABLE1.ID_X, MAX(MYTABLE1.DATE_X) AS MAXDATE
FROM `C:\Users\andy3h\Desktop\SOTEST1.xlsx`.MYTABLE MYTABLE1
GROUP BY MYTABLE1.ID_X
) AS MAXDATES
ON MYTABLE.ID_X = MAXDATES.ID_X
AND MYTABLE.DATE_X = MAXDATES.MAXDATE)
LEFT OUTER JOIN (
SELECT MYTABLE2.ID_X
FROM `C:\Users\andy3h\Desktop\SOTEST1.xlsx`.MYTABLE MYTABLE2
GROUP BY MYTABLE2.ID_X
HAVING COUNT(1) > 1
) AS DUPTABLE
ON MYTABLE.ID_X = DUPTABLE.ID_X)
With the code in place MSQuery will complain the query can't be represented graphically. It's OK. The query will execute -- it might take longer than expected to run at this stage. I'm not sure why, but it should run much faster on subsequent refreshes. Once results return, File | Return data to Excel. Accept the defaults on the Import Data dialog.
That's the technique. To refresh the query against new data simply Data | Refresh. If you need to tweak the query you can get back to it though Excel via Data | Connections | Properties | Definition tab.
The code I provided returns your original data plus the NEW_DATA column, which has value 1 if the ID is duplicated and the date is the maximum date for that ID, otherwise 0. This code will not sort out ties if an ID's maximum date is on several rows. All such rows will be tagged 1.
Edit: The code is easily modified to ignore the duplication logic and show most recent row for all IDs. Simply change the last bit of the SELECT clause to read
IIF(MAXDATES.ID_x IS NULL,0,1) AS NEW_DATA
In that case, you could also remove the final LEFT JOIN with alias DUPTABLE.
Sort by ID, then by DATE (ascending). Define entries in new column to be 1 if previous row has the same ID and next row has a different ID or is empty (for last row), 0 otherwise.
It could be done in VBA. I'd be interested to know if this is possible just using formulas, I had to do something similar once before.
Sub Macro1()
Dim rowCount As Long
Sheets("Sheet1").Activate
rowCount = Cells(Rows.Count, 1).End(xlUp).Row
Columns("A:D").Select
Selection.AutoFilter
Range("D2:D" & rowCount).Select
Selection.ClearContents
Columns("A:D").Select
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("B1:B" & rowCount), SortOn:=xlSortOnValues
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("A1:A" & rowCount), SortOn:=xlSortOnValues
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.Apply
Dim counter As Integer
For counter = 2 To rowCount
Cells(counter, 4) = 1
If Cells(counter, 1) = Cells(counter + 1, 1) Then Cells(counter, 4) = 0
Next counter
End Sub
So you activate the sheet and get the count of rows.
Then select and autofilter the results, and clear out Column D which has the 0s or 1s. Then filter on the values mbroshi suggested that you say you're already using. Then execute a loop for each record, changing the value to 1, but then back to 0 if the value ahead of it has the same ID.
Depending on your processor I dont think this would take more than a minute or two to run. If you do find something using formulas I would be interested to see it!