How do I run several codes at once?-CodePudding

I work with OLAP Cubes and have created code on several occasions for different purposes but now I would like to combine several functions, how do I succeed with that?

This is what I need help putting together. I am a real beginner and have solved most things through google before but now I cant find anything that I understand or that helps me.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$A$5" Then Exit Sub
    On Error Resume Next
    Application.ScreenUpdating = False
    Dim pt As PivotTable
    Dim ws As Worksheet
    For Each ws In Worksheets
        For Each pt In ws.PivotTables
            pt.PivotFields("[Casino].[Casino].[Casino]").CurrentPageName = "[Casino].[Casino].&[" & Format(ActiveSheet.Cells(5, 1).Value, "") & "]"
            pt.PivotFields
        Next pt
    Next ws
    GoTo Sluta
Fel:
    MsgBox "Något gick fel :("
Sluta:
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$A$3" Then Exit Sub
    On Error Resume Next
    Application.ScreenUpdating = False
    Dim pt As PivotTable
    Dim ws As Worksheet
    For Each ws In Worksheets
        For Each pt In ws.PivotTables
            pt.PivotFields("[Date].[Month Number].[Month Number]").CurrentPageName = "[Date].[Month Number].&[" & Format(ActiveSheet.Cells(3, 1).Value, "") & "]"
            pt.PivotFields
        Next pt
    Next ws
    GoTo Sluta
Fel:
    MsgBox "Något gick fel :("
Sluta:
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$A$2" Then Exit Sub
    On Error Resume Next
    Application.ScreenUpdating = False
    Dim pt As PivotTable
    Dim ws As Worksheet
    For Each ws In Worksheets
        For Each pt In ws.PivotTables
            pt.PivotFields("[Date].[Year].[Year]").CurrentPageName = "[Date].[Year].&[" & Format(ActiveSheet.Cells(2, 1).Value, "") & "]"
            pt.PivotFields
        Next pt
    Next ws
    GoTo Sluta
Fel:
    MsgBox "Något gick fel :("
Sluta:
    Application.ScreenUpdating = True
End Sub

CodePudding user response：

Write everything in one procedure and do not repeat your code.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim PivFld As String
    Dim PageName As String

    On Error GoTo Fel
    Application.ScreenUpdating = False
    
    Select Case Target.Address
    Case "$A$5"
        PivFld = "[Casino].[Casino].[Casino]"
        PageName = "[Casino].[Casino].&[" & Format(ActiveSheet.Cells(5, 1).Value, "") & "]"
    Case "$A$3"
        PivFld = "[Date].[Month Number].[Month Number]"
        PageName = "[Date].[Month Number].&[" & Format(ActiveSheet.Cells(3, 1).Value, "") & "]"
    Case "$A$2"
        PivFld = "[Date].[Year].[Year]"
        PageName = "[Date].[Year].&[" & Format(ActiveSheet.Cells(2, 1).Value, "") & "]"
    Case Else
        Exit Sub
    End Select

    
    Dim ws As Worksheet
    For Each ws In Worksheets
        Dim pt As PivotTable
        For Each pt In ws.PivotTables
            pt.PivotFields(PivFld).CurrentPageName = PageName
            pt.PivotFields
        Next pt
    Next ws
    
    GoTo Sluta
Fel:
    MsgBox "Något gick fel :("
Sluta:
    Application.ScreenUpdating = True

End Sub

Note that On Error Resume Next hides all error messages and you will never know if something goes wrong. Instead use On Error GoTo Fel and at least you get informed that something went wrong.

CodePudding user response：

you can combine all the ones into a single code and use if-statements for the differences:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fields As String
Dim pageName as String
If Target.Address = "$A$5" Then fields="[Casino].[Casino].[Casino]": pageName = "[Casino].[Casino].&["
If Target.Address = "$A$3" Then fields="[Date].[Month Number].[Month Number]": pageName = "[Date].[Month Number].&["
If Target.Address = "$A$2" Then fields="[Date].[Year].[Year]": pageName = "[Date].[Year].&["
If fields = "" Then Exit Sub
On Error Resume Next
Application.ScreenUpdating = False
Dim pt As PivotTable
Dim ws As Worksheet
For Each ws In Worksheets
For Each pt In ws.PivotTables
pt.PivotFields(fields).CurrentPageName = pageName & Format(Target.Value, "") & "]"
pt.PivotFields
Next pt
Next ws
GoTo Sluta
Fel:
MsgBox "Något gick fel :("
Sluta:
Application.ScreenUpdating = True

End Sub

Also adding variables fields and pageName to simplify.