Excel Macro for SaveAs Filename

Haven't posted much about Excel but this one has been the most common request from business users.

This is a macro to override the "Save As" filename.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

  Dim sPath As String, sFilename As String, sDate As String

  sPath = ""
  sFilename = ""

  'Take the current path of your spreadsheet
  sPath = ActiveWorkbook.Path
  
  'Whatever value you have on cell B2 will be used as filename
  sFilename = WorksheetFunction.Proper(Range("B2"))
  
  'Just general cleanup
  sFilename = Replace(sFilename, "/", "-")
  
  'Builds the complete file path and filename
  sFilename = sPath & "\" & sFilename & ".xlsm"

  If SaveAsUI = True Then
    Cancel = True
    sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=sFilename, fileFilter:="Excel Files (*.xlsm), *.xlsm")
    If sFileSaveName <> False Then
      ActiveWorkbook.SaveAs sFileSaveName
    End If
  End If

End Sub