How can I use event`s with a Personal Workbook macros

Eric Penfold

Active Member
Joined
Nov 19, 2021
Messages
424
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
I have a situation where I am trying to use a Personal workbook macros but the event is trigged by the current open workbook. How is this possible?

VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


    If Sh.Name <> "Summary" And Sh.Name <> "Trend" And Sh.Name <> "Supplier BO" And Sh.Name <> "Diff Depot" _
        And Sh.Name <> "BO WO" And Sh.Name <> "Diff Depot" Then
        
        
        If Target.Column = 1 Then
            If Sh.Range("AA1") = "" Then
                Sh.Range("AA1") = 1
                If DoubleClick = True Then
                    Sh.Range("AA1") = ""
                    Exit Sub
                Else
                    
                    Call Group_OrderNos
                    
                    Call Fill_NSI_Cells
                    
                    Call Duplicate_Delete
                    
                    Call Number_To_Text_Macro
                    
                    Call Format_Cells
                    
                End If
            End If
        End If
        
        If Target.Column = 10 Then
            If Sh.Range("AA1") = "" Then
                Sh.Range("AA1") = 1
                Call BO_Drop_DownList
                Call BO_Reason
            End If
        End If
    End If
    
End Sub
 
Yes i agree but if it is xlsx & free of macros it will be a lot less big. I saved it as xlsx other day and it saved a lot quicker.
 
Upvote 0

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Yes i agree but if it is xlsx & free of macros it will be a lot less big. I saved it as xlsx other day and it saved a lot quicker.
Unless the code involves many modules, userforms etc, code is just plain text with no formatting, formulaes, shapes etc (unlike data in the workbook,) so it wouldn't make much difference in terms of size.

But if you say you noticed a difference in speed then go for it.
 
Upvote 0
Thanks Jaafar

Would you be able to help with making the events work in xlsx connecting to Personal Workbook. Very much appreciate it if you could.
 
Upvote 0
Thanks Jaafar

Would you be able to help with making the events work in xlsx connecting to Personal Workbook. Very much appreciate it if you could.
I am afraid, I will be leaving shortly so I won't be able to post some code now.
But essencially, what you need is a way of hooking the Application class events when loading the personal.xlsb or addin files. This allows the personal.xlsb or Addin to get a pointer to all open workbooks and sink their events.

There are many code examples online and on this site ... Search for "Excel Application Events" and for the "WithEvents" Keyword.
 
Upvote 0
Would you be able to help with making the events work in xlsx connecting to Personal Workbook. Very much appreciate it if you could

Here is a barebone code that can be used as a starting point for your own project:

Place this code in the ThisWorkbook Module of the Personal.xlsb or Addin and save:
VBA Code:
Option Explicit

Private WithEvents xlAppEvents As Application

Private Sub Workbook_Open()
    Set xlAppEvents = Application
End Sub

Private Sub xlAppEvents_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    MsgBox "You Clicked\Selected Range : " & Target.Address(, , , True)
End Sub

Now, everytime excel is started, the addin\personal.xlsb will load, their Open event will sink the application events and all open workbooks will be monitored events-wise.

In order to get a pointer to the current workbook from the above SheetSelectionChange event, you can easily do so via the Parent Property of the Sh argument as follows
Private Sub xlAppEvents_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Dim oWbk As Workbook Set oWbk = Sh.Parent End Sub

Once you have obtained the pointer to the current workbook, you can easily decide which workbook should run which subsequent code ... Something along these lines :
VBA Code:
Private Sub xlAppEvents_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    Dim oWbk As Workbook
    Set oWbk = Sh.Parent
 
    Select Case True
        Case UCase(oWbk.Name) Like "BOOK1" & "*"
            'run code here for Book1
        Case UCase(oWbk.Name) Like "BOOK2" & "*"
            'run code here for Book2
        Case Else
            'run some other code if needed
    End Select
 
End Sub
 
Last edited:
Upvote 0
Here is a barebone code that can be used as a starting point for your own project:

Place this code in the ThisWorkbook Module of the Personal.xlsb or Addin and save:
VBA Code:
Option Explicit

Private WithEvents xlAppEvents As Application

Private Sub Workbook_Open()
    Set xlAppEvents = Application
End Sub

Private Sub xlAppEvents_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    MsgBox "You Clicked\Selected Range : " & Target.Address(, , , True)
End Sub

Now, everytime excel is started, the addin\personal.xlsb will load, their Open event will sink the application events and all open workbooks will be monitored events-wise.

In order to get a pointer to the current workbook from the above SheetSelectionChange event, you can easily do so via the Parent Property of the Sh argument as follows
Private Sub xlAppEvents_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Dim oWbk As Workbook Set oWbk = Sh.Parent End Sub

Once you have obtained the pointer to the current workbook, you can easily decide which workbook should run which subsequent code ... Something along these lines :
VBA Code:
Private Sub xlAppEvents_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    Dim oWbk As Workbook
    Set oWbk = Sh.Parent
 
    Select Case True
        Case UCase(oWbk.Name) Like "BOOK1" & "*"
            'run code here for Book1
        Case UCase(oWbk.Name) Like "BOOK2" & "*"
            'run code here for Book2
        Case Else
            'run some other code if needed
    End Select
 
End Sub
This code works but I can`t use the result in my other Macros or can I?

VBA Code:
Private Sub xlAppEvents_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    Dim oWbk   As Workbook
    Set oWbk = Sh.Parent
    
    Select Case True
        
        Case UCase(oWbk.Name) Like "2023 Alton Back OrderT" & " * """
            
            If Sh.Name <> "Summary" And Sh.Name <> "Trend" And Sh.Name <> "Supplier BO" And Sh.Name <> "Diff Depot" _
                And Sh.Name <> "BO WO" And Sh.Name <> "Diff Depot" Then
                
                If Sh.Target.Column = 1 Then
                    If Sh.Range("AA1") = "" Then
                        Sh.Range("AA1") = 1
                        If DoubleClick = True Then
                            Sh.Range("AA1") = ""
                            Exit Sub
                        Else
                            
                            Call Group_OrderNos
                            
                            Call Fill_NSI_Cells
                            
                            Call Duplicate_Delete
                            
                            Call Number_To_Text_Macro
                            
                            Call Format_Cells
                            
                        End If
                    End If
                End If
                
                If Target.Column = 10 Then
                    If Sh.Range("AA1") = "" Then
                        Sh.Range("AA1") = 1
                        Call BO_Drop_DownList
                        Call BO_Reason
                    End If
                End If
            End If
            
        Case UCase(oWbk.Name) Like "2023 Coventry Back Order" & "*"
            
            If Sh.Name <> "Summary" And Sh.Name <> "Trend" And Sh.Name <> "Supplier BO" And Sh.Name <> "Diff Depot" _
                And Sh.Name <> "BO WO" And Sh.Name <> "Diff Depot" Then
                
                If Sh.Target.Column = 1 Then
                    If Sh.Range("AA1") = "" Then
                        Sh.Range("AA1") = 1
                        If DoubleClick = True Then
                            Sh.Range("AA1") = ""
                            Exit Sub
                        Else
                            
                            Call Group_OrderNos
                            
                            Call Fill_NSI_Cells
                            
                            Call Duplicate_Delete
                            
                            Call Number_To_Text_Macro
                            
                            Call Format_Cells
                            
                        End If
                    End If
                End If
                
                If Target.Column = 10 Then
                    If Sh.Range("AA1") = "" Then
                        Sh.Range("AA1") = 1
                        Call BO_Drop_DownList
                        Call BO_Reason
                    End If
                End If
            End If
            
        Case UCase(oWbk.Name) Like "2023 Balisdon Back Order" & "*"
            
            If Sh.Name <> "Summary" And Sh.Name <> "Trend" And Sh.Name <> "Supplier BO" And Sh.Name <> "Diff Depot" _
                And Sh.Name <> "BO WO" And Sh.Name <> "Diff Depot" Then
                
                If Sh.Target.Column = 1 Then
                    If Sh.Range("AA1") = "" Then
                        Sh.Range("AA1") = 1
                        If DoubleClick = True Then
                            Sh.Range("AA1") = ""
                            Exit Sub
                        Else
                            
                            Call Group_OrderNos
                            
                            Call Fill_NSI_Cells
                            
                            Call Duplicate_Delete
                            
                            Call Number_To_Text_Macro
                            
                            Call Format_Cells
                            
                        End If
                    End If
                End If
                
                If Target.Column = 10 Then
                    If Sh.Range("AA1") = "" Then
                        Sh.Range("AA1") = 1
                        Call BO_Drop_DownList
                        Call BO_Reason
                    End If
                End If
            End If
            
    End Select
    
End Sub
 
Upvote 0
You can, but the macros you want to call need to take arguments into account for the data they will be proccessing.
For example, instead of:


Public Sub Duplicate_Delete()
with activesheet
.range("A1").currentregion.....
end with
End Sub

use:

Public Sub Duplicate_Delete(TargetWorksheet as WorkSheet)
with targetworksheet
.range("A1").currentregion.....
end with
End Sub
 
Upvote 0
VBA Code:
Application.Run "'" & oWbk.FullName & "'!Group_OrderNos"
Do the same when calling the other Macros (Fill_NSI_Cells, Duplicate_Delete, Number_To_Text_Macro, Format_Cells ... etc )
The above syntax assumes the Macros don't have arguments (which I can see from the code you posted)

Also, note that all the Macros must reside in Standard\Normal Modules.
 
Upvote 0
I got your code to work but now it`s stopped?
If I could send my Personal Macro Book and a sample of the current workbook. Could you get the event to work & one of the modules to work then I will complete the rest
 
Upvote 0

Forum statistics

Threads
1,215,219
Messages
6,123,687
Members
449,117
Latest member
Aaagu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top