Excel VBA проблемы с кликами

Question

У меня есть код Excel VBA, который открывает базу данных MS Access и фильтры на основе значения ячейки в ячейках файла Excel.У меня есть определенный диапазон, но доступ откроется, если я щелкну в любом месте в Excel (Примечание корректно фильтрует только, если я щелкнул мышью правильные ячейки).

Option Explicit


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Init As Integer
    Dim oApp As Object
    Dim LPath As String


   'Path to Access database
    LPath = "J:\Admin\Access Database for Punch List.accdb"

     'Exit if selection is more than one cell
    If Target.Cells.Count > 1 Then
        Exit Sub
    End If

    ' Validate if selected cell is in range
    If Not Application.Intersect(Range("A23:A2000"), Range(Target.Address)) Is Nothing Then



        ' Assign studentid value from current cell
        Init = Target.Value


        ' Call the open procedure with current cell value

        Call CheckIfFileOpen

    End If
 Call OpenAccess(Init)
End Sub

Sub CheckIfFileOpen()

Dim fileName As String
Dim oApp As Object
Dim Init As Integer


fileName = "J:\Admin\Access Database for Punch List.accdb"

'Call function to check if the file is open
If IsFileOpen(fileName) = False Then



Else

    'The file is open or another error occurred
    With GetObject(, "access.application").Quit
End With

End If


End Sub

Sub OpenAccess(Init)


    Dim oApp As Object
    Dim LPath As String




    'Path to Access database
    LPath = "J:\Kyle\Access Database for Punch List.accdb"

       'Open Access and make visible
   Set oApp = CreateObject("Access.Application")
    oApp.Visible = True


   'Open Access database as defined by LPath variable

     oApp.OpenCurrentDatabase LPath
   oApp.DoCmd.OpenForm "frm_AllRecords"
   oApp.DoCmd.ApplyFilter , "Initiative_Nbr=" & Init
    oApp.Forms("frm_AllRecords").SetFocus


End Sub

Результатом будет код, позволяющий запускать VBA только при нажатиина клетку в моем диапазоне.