BeforeSave loops and workbook closes - vba

Question

I am attempting to save a "copy" of a workbook by forcing a set path and filename. The following code does two things that I would like to avoid. First, the "message" is displayed twice. Why is this occurring and how can I prevent it? Second, the workbook closes after the save completes, even if I only click on the save icon. I need the workbook to stay open unless the red "x" is pressed. Here is the code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Const Function_Area = "Benefits"
Dim Full_Filename As String
Dim Temp_Filename_Prefix As String
Dim Temp_Filename_Suffix As String
Dim Temp_Path As String
Dim Error_Check As Boolean
Dim End_Msg As Variant
Dim Temp_Object As Object
Set Temp_Object = CreateObject("WScript.Shell")
With Temp_Object
Temp_Path = .SpecialFolders("Desktop") & "\"
End With
If Range("REVIEW_TYPE").Value = "Prototype Review" Then
Temp_Filename_Prefix = Range("CUSTOMER_NAME").Value & Function_Area & "_PROTO_"
End If
If Range("REVIEW_TYPE").Value = "Final Review" Then
Temp_Filename_Prefix = Range("CUSTOMER_NAME").Value & Function_Area & "_FINAL_"
End If
If Range("REVIEW_TYPE").Value = "Compliance Review" Then
Temp_Filename_Prefix = Range("CUSTOMER_NAME").Value & Function_Area & "_COMPLIANCE_"
End If
Temp_Filename_Suffix = Format(Date, "yyyymmdd")
Temp_Filename_Suffix = Temp_Filename_Suffix & "C"
Full_Filename = Temp_Path & Temp_Filename_Prefix & Temp_Filename_Suffix
End_Msg = "This file has been saved to your DESKTOP as " & Chr(13) & Chr(10) & _
Full_Filename
End_Msg = MsgBox(End_Msg, vbInformation, "FILE SAVED")
' Save file to Desktop
ActiveWorkbook.SaveAs Filename:=Full_Filename, FileFormat:=52
ThisWorkbook.Saved = True
End Sub
Thank you for any guidance you can provide.

Answer 1

just a couple of suggestions to clean up the code
you can use this in place of the three if-then statements, just to unclutter the code
Dim prfx As String
Select Case Range("REVIEW_TYPE").Value
Case "Prototype Review": prfx = "_PROTO_"
Case "Final Review": prfx = "_FINAL_"
Case "Compliance Review": prfx = "_COMPLIANCE_"
Case Else: ' put code here, for not any of above
End Select
Temp_Filename_Prefix = Range("CUSTOMER_NAME").Value & Function_Area & prfx
also shorten the following
With Temp_Object
Temp_Path = .SpecialFolders("Desktop") & "\"
End With
just use
Temp_Path = Temp_Object.SpecialFolders("Desktop") & "\"
also replace & Chr(13) & Chr(10) & with & vbCrLf & or with & vbNewLine &