JayJay6
09-12-2011, 02:29 AM
Hi,
I have a pretty stupid problem.
I am not that familiar with VBA scripts in Excel, and my problem is I have a Script which simply doesn't run. If I try to run the subs, I get a pop-up asking for a "Macro Name" ? The script debugs with no errors. I have made other scripts which runs without problems i the same workbook.
These are the subs:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Application.Range("RegionFilterRange")) _
Is Nothing Then
UpdatePivotFieldFromRange _
"RegionFilterRange", "Col0", "PivotTable1"
End If
End Sub
Public Sub UpdatePivotFieldFromRange(RangeName As String, FieldName As String, _
PivotTableName As String)
Dim rng As Range
Set rng = Application.Range("RegionFilterRange")
Dim pt As PivotTable
Dim Sheet As Worksheet
For Each Sheet In Application.ActiveWorkbook.Worksheets
On Error Resume Next
Set pt = Sheet.PivotTables("PivotTable1")
Next
If pt Is Nothing Then GoTo Ex
On Error GoTo Ex
pt.ManualUpdate = True
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim Field As PivotField
Set Field = pt.PivotFields("Col0")
Field.ClearAllFilters
Field.EnableItemSelection = False
SelectPivotItem Field, rng.Text
pt.RefreshTable
Ex:
pt.ManualUpdate = False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Public Sub SelectPivotItem(Field As PivotField, ItemName As String)
Dim Item As PivotItem
For Each Item In Field.PivotItems
Item.Visible = (Item.Caption = ItemName)
Next
End Sub
Any ideas ?
Br,
Jakob
I have a pretty stupid problem.
I am not that familiar with VBA scripts in Excel, and my problem is I have a Script which simply doesn't run. If I try to run the subs, I get a pop-up asking for a "Macro Name" ? The script debugs with no errors. I have made other scripts which runs without problems i the same workbook.
These are the subs:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Application.Range("RegionFilterRange")) _
Is Nothing Then
UpdatePivotFieldFromRange _
"RegionFilterRange", "Col0", "PivotTable1"
End If
End Sub
Public Sub UpdatePivotFieldFromRange(RangeName As String, FieldName As String, _
PivotTableName As String)
Dim rng As Range
Set rng = Application.Range("RegionFilterRange")
Dim pt As PivotTable
Dim Sheet As Worksheet
For Each Sheet In Application.ActiveWorkbook.Worksheets
On Error Resume Next
Set pt = Sheet.PivotTables("PivotTable1")
Next
If pt Is Nothing Then GoTo Ex
On Error GoTo Ex
pt.ManualUpdate = True
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim Field As PivotField
Set Field = pt.PivotFields("Col0")
Field.ClearAllFilters
Field.EnableItemSelection = False
SelectPivotItem Field, rng.Text
pt.RefreshTable
Ex:
pt.ManualUpdate = False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Public Sub SelectPivotItem(Field As PivotField, ItemName As String)
Dim Item As PivotItem
For Each Item In Field.PivotItems
Item.Visible = (Item.Caption = ItemName)
Next
End Sub
Any ideas ?
Br,
Jakob