MsgBox Requires two OK selections to clear

[mhintzman]

I have an macro that querys a list list of "Projects" and displays them in a popup for the user to select from. I first check the Project to insure a "Security File" exists (list of project members) and then I check to see if the user is a member of the "Project". I display a MsgBox if 1) the "Security File" does not exist and 2) if the user is not a member of the "Project".

I both cases the MsgBox requires two selections of the "OK" button to clear it when it is displayed. I've tried the Application.EnableEvents = False/True that many of the threads on this subject seem to suggest, but have not been able to get anything to work without requiring two selections of the OK button.

Can someone please identify what the problem is so that I can get this code into production?

Here are the Subs that I am using for the PopUp Menu:

[FONT=courier new]Sub DeletePopUpMenu()
    ' Delete the popup menu if it already exists.
    On Error Resume Next
    Application.CommandBars(Mname).Delete
    On Error GoTo 0
End Sub

Sub DisplayProjPopUpMenu()
    ' Delete the popup menu if it exist.
    Call DeletePopUpMenu

    Call Custom_PopUpMenu

    ' Show the popup menu.
    On Error Resume Next
    Application.CommandBars(Mname).ShowPopup
    'On Error GoTo 0
End Sub

Sub Custom_PopUpMenu()

    Dim i As Integer
    ' Add popup menu with three buttons.
    i = 10
    With Application.CommandBars.Add(Name:=Mname, Position:=msoBarPopup, _
        MenuBar:=False, Temporary:=True)
        Do While Cells(i, 1).Value <> ""
            With .Controls.Add(Type:=msoControlButton)
                .Caption = Sheets("Summary-Data").Cells(i, 1)
                .FaceId = 32
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestSelection(""" & ActiveSheet.Cells(i, 1) & """)"
            End With
            i = i + 1
        Loop
    End With
    Sheets("Summary").Activate

End Sub

Sub TestSelection(projName)

    Dim ProjNameArray() As String
    Dim fProjSec As String
    Dim fileExists As String
    Dim f As Integer
    Dim lineCount As Long
    Dim strLine As String
    Dim strUserID As String
    Dim blnFound As Boolean
    
    Application.EnableEvents = False
    ProjNameArray() = Split(projName, " ")
    fProjSec = "\\RPMELROY\ITK-Results" & ProjNameArray(0) & "_members.txt"
    fileExists = VBA.FileSystem.Dir(fProjSec)
    If fileExists = VBA.Constants.vbNullString Then
        MsgBox "Security File " & ProjNameArray(0) & " does not exist." & vbCrLf & vbCrLf & "Please notify administrator.", vbCritical
        ReturnCode = 99
        Exit Sub
    Else
        f = FreeFile
        strUserID = Environ("Username")
        blnFound = False
        Open fProjSec For Input As [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=f"]#f[/URL] 
        Do While Not EOF(f)
            lineCount = lineCount + 1
            Line Input [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=f"]#f[/URL] , strLine
            If strLine = Environ("Username") Then
                blnFound = True
                Exit Do
            End If
        Loop
    End If
    If blnFound Then
        'Store the selected Project in Cells A1 & A3 of the Summary_Data sheet
        Range("'Summary-Data'!A1") = ProjNameArray(0)
        Range("'Summary-Data'!A3") = projName
    Else
        MsgBox "Access NOT allowed." & vbCrLf & "User is not a Project member." & vbCrLf & "Please select another Project.", vbCritical
        ReturnCode = 99
    End If
    Application.EnableEvents = True
    
End Sub[/FONT]

 

[mhintzman]

Can Someone please take a quick look at this and provide feedback. Novice Excel Macro user here.