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.
Related
this code is running well at initially.
But Error 1004 come out after few times testing.
the code break at this line
Set Field = pt.PivotFields("Rep Order#")
I have checked the field name in pivot table. it is exactly the same.
Can anyone help to have a look ?
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Set the Variables to be used
Dim pt As PivotTable
Dim pt2 As PivotTable
Dim Field As PivotField
Dim Field2 As PivotField
Dim pivot_item As PivotItem
Dim pivot_item2 As PivotItem
Dim NewCat As String
Dim test_val As String
'Here you amend to suit your data
Set pt = Worksheets("Backlog Analysis 2").PivotTables("PivotTable2")
Set pt2 = Worksheets("Backlog Analysis 2").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Rep Order#")
Set Field2 = pt2.PivotFields("Rep Order#")
NewCat = Worksheets("Backlog Analysis 2").Range("L11").Value
'Here is the test if the input field exists
test_val = NewCat
For Each pivot_item In pt.PivotFields("Rep Order#").PivotItems
If pivot_item.Name = test_val Then
Exit For
End If
Next pivot_item
On Error Resume Next
'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters
Field.PivotFilters.Add2 Type:=xlCaptionContains, Value1:=NewCat
pt.RefreshTable
End With
With pt2
Field2.ClearAllFilters
Field2.PivotFilters.Add2 Type:=xlCaptionContains, Value1:=NewCat
pt.RefreshTable
End With
End Sub
If the code works initially and then stops working, my first guess would be to either turn off Events or limit the code to run only when a specific range changes. Your code now we run every time anything changes in the workbook (including when your code changes the Pivot Tables).
Try adding this at the beginning of your code:
Application.EnableEvents = False
And this at the end:
Application.EnableEvents = True
Alternatively, it appears that you really only want this to run when Range("L11") changes. So, you could add a conditional at the top:
If Target.Address = "$L$11" And Sh.Name = "Backlog Analysis 2" Then
'Run Your Code
End If
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
First post. I have the relatively simple code below and am getting a
User-defined type not defined
error. I know that the stand alone code works when I place it into one Sub but for various reasons I want to split it out so that in my larger workbook I can just call on the second sub rather than having to copy and paste the whole loop multiple times. The purpose of the code is to autosize the specified range in excel.
Sub letsGo()
Dim rng As Range
Dim sht As Worksheet
Set rng = ThisWorkbook.Sheets("Sheet1").Range("Range1")
Set sht = ThisWorkbook.Sheets("Sheet1")
Call whyDoesntThisWork(sht, rng)
End Sub
Private Sub whyDoesntThisWork(rangeSheet As Sheet, rangeTable As Range)
Dim Col As Range
Dim reSize As Range
For Each Col In rangeTable.Columns
If Col.Hidden = False Then
Set reSize = rangeSheet.Range(rangeSheet.Cells(rangeTable.Row, Col.Column), rangeSheet.Cells(rangeTable.Rows.Count, Col.Column)) reSize.Columns.autoFit
End If
Next Col
End Sub
You have two different data types:
Private Sub whyDoesntThisWork(rangeSheet As Sheet, rangeTable As Range)
rangeSheet is a Sheet, but when you call it, you pass:
Call whyDoesntThisWork(sht, rng)
sht is of type WorkSheet
That's your inconsistency. I recommend you change your definition to:
Private Sub whyDoesntThisWork(rangeSheet As WorkSheet, rangeTable As Range)
Change rangeSheet As Sheet to rangeSheet As Worksheet
I found a UDF that calculates the values of a cell based on their color. It worked perfectly the first time that I used it. However, now when I change the color of a cell (the color dictates if the cell has been planned or executed), in the existing workbook it does not auto-update. See code below:
Function SumByColor(CellColor As Range, rRange As Range)
Application.Volatile True
Dim cSum As Long
Dim ColIndex As Integer
Dim cl As Variant
ColIndex = CellColor.Interior.ColorIndex
For Each cl In rRange
If cl.Interior.ColorIndex = ColIndex Then
cSum = WorksheetFunction.Sum(cl, cSum)
End If
Next cl
SumByColor = cSum
End Function
I have tried Application.Volitale, but no luck. F9 works to update the cells that house the function. Though, it would be better to auto-update in case I get busy, or walk away from my WS. Any ideas?
You can create a worksheet event proc that will run when a change is recognized on the sheet:
Private Sub Worksheet_Change(ByVal Target as Range)
'Call function with appropriate variables
End Sub
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.