I have a spreadsheet where the users input their Username and the file is
saved automatically using the loginname. Everything seems to work fine except
that when I save the file through FileClose command both prompts (see below)
keeps on appearing in a loop.

Please please suggest a solution. Many thanks in advance.

If required, I could send a dummy file to check the codes.


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'a = MsgBox("Do you really want to save the workbook?", vbYesNo)
' If a = vbNo Then Cancel = True
Dim Response, MyString, Msg, Style, Title, Help, Ctxt
Dim MyFileName As String
Const SaveSheet As String = "Jan"
Const SaveCell As String = "Z24"
Dim wb As Workbook
Set wb = ActiveWorkbook
'
'Cancel Save event
Cancel = False
'
'Create string variable for file name
Dim strFName As String
'Set file path in string
strFName = Sheets("Jan").Range("Z24").Value
'Check if V23 - UserName is empty
If wb.Worksheets("Jan").Range("V23") < "" Then
'Cancel Save event
Cancel = True
'If not, then verify UserName
If MsgBox("Your UserName is (" & Sheets("Jan").Range("V23").Value & "),"
& _
vbCrLf & " Is this Correct?", vbYesNo, "Save Prompt") = vbYes Then
'If name is correct, Save file
Application.DisplayAlerts = False
Application.EnableEvents = False
wb.SaveAs strFName
Application.EnableEvents = True
Application.DisplayAlerts = True
Else
'If UserName is NOT correct, prompt to change it
MsgBox "Please enter CORRECT UserName"
End If
Else
'Prompt for UserName
MsgBox "You have not entered your UserName" & vbCrLf & _
"on the first sheet (" & SaveSheet & "), in cell (V23)"
End If
End Sub