VBA is only running on "Save" but not on "Save As"

Question

I want to import the name of the excel workbook to particular sets of cells. The function Display_File_Name does the trick.

The following code works when I do Save (Ctrl+S) but it doesn't work when I do Save As. I don't see filename getting updated in the cells. How can the function be run even when the user choose to do Save As?

My current workaround is using Workbook_BeforeClose or Workbook_AfterSave but this will prompt for saving action, which I want to avoid.

Could you help me with this?

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

    Call Display_File_Name
    
End Sub

Function Display_File_Name()

    'Import filename
    Set OpenBook = ActiveWorkbook
    
    Filename = OpenBook.Name
    'Record filename on Print page
    OpenBook.Worksheets(4).Range("A2") = Filename
    'Find the last row with values
    LR= OpenBook.Worksheets(6).Columns("B").Find("*", _
        SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
    'Record filename
    OpenBook.Worksheets(6).Range("A2:A" & LR) = Filename

End Function

References used:

For Workbook_BeforeSave: Link Link

For Workbook_BeforeClose: Link

Answer 1

Update Workbook Before Saving

Tips

• Option Explicit forces you to declare all variables. Read about its benefits.

• The Call keyword is considered deprecated. There is really no use of it.

• DisplayFileName is the preferred variable and procedure naming convention in VBA. Display_File_Name is kind of reserved for Classes.

• To reference the workbook containing this code, in the ThisWorkbook module you can use the Me keyword. Anywhere else you will use ThisWorkbook.

• Although using Function works, your procedure should use Sub because it only does. It doesn't return anything like a function does. Consider the following simple example:

  ' Returns the upper-case version of a string. 
  Function GetUCase(ByVal S As String) As String
      GetUCase = UCase(S)
  End Function
  

  It can be utilized with:

  Sub Test() ' Prints a string and its upper-case version. 
      Const sOld As String = "small"
      Dim sNew As String: sNew = GetUCase(sOld)
      Debug.Print sOld & ", " & sNew ' prints 'small, SMALL'
  End Sub
  

• Although you are allowed to 'borrow' some of the VBA's keywords, it is best avoided. You have used the exact casing in Filename which is the first argument name of the SaveAs or SaveCopyAs methods, but it conflicts with the variable naming convention (FileName).

• To avoid some surprises (not in this case though), I prefer using Value when writing a value to a range e.g. ws.Range("A1").Value = 1.

• In the Find method, you are unnecessarily using the SearchOrder argument while you are searching in one column. The xlValues parameter of the LookIn argument will fail if there are hidden cells (rows or columns), so I prefer the xlFormulas parameter for finding a cell containing anything, which will also find a cell containing a formula evaluating to "". If the Find method in your code doesn't find a cell, an error will occur. See the code below how this is avoided.

• I haven't fixed the worksheet referencing by using indexes since I don't know the worksheet names, but you should most definitely abandon this way of referencing worksheets.

  • When using indexes e.g. Set ws = wb.Worksheets(1), a user could move the tab to another position and your code would fail.
  • Less likely, when using worksheet names e.g. Set ws = wb.Worksheets("Sheet1"), a user could rename the worksheet, and again, the code would fail.
  • Least likely, if you use the code names e.g. Set ws = Sheet1 or just use Sheet1 instead of the variable, a user could rename the code name and the code would fail.

The Code

Standard Module e.g. Module1

• Alternatively, you can leave it in the ThisWorkbook module.

Option Explicit

Sub DisplayFileName(ByVal wb As Workbook)
    
    ' Validate the workbook ('wb').
    If wb Is Nothing Then Exit Sub
    
    ' Write the file name to a variable ('sFileName').
    Dim sFileName As String: sFileName = wb.Name
    
    ' Create a reference to the Print worksheet ('pws').
    Dim pws As Worksheet: Set pws = wb.Worksheets(4)
    ' Create a reference to the Print cell ('pCell').
    Dim pCell As Range: Set pCell = pws.Range("A2")
    ' Write the file name to the Print cell.
    pCell.Value = sFileName
    ' Autofit Print column.
    'pCell.EntireColumn.AutoFit
    
    ' Create a reference to the Destination worksheet ('dws').
    Dim dws As Worksheet: Set dws = wb.Worksheets(6)
    
    ' Create a reference to the Destination last cell ('dlCell') in column 'B'.
    Dim dlCell As Range
    Set dlCell = dws.Columns("B").Find("*", , xlFormulas, , , xlPrevious)
    ' Validate Destination last cell.
    If dlCell Is Nothing Then Exit Sub ' empty 'B' column
    
    ' Write the last row to a variable ('dlRow').
    Dim dlRow As Long: dlRow = dlCell.Row
    ' Validate the last row.
    If dlRow < 2 Then Exit Sub ' the last row cannot be 1 because of '"A2:A"'.
    
    ' Create a reference to the Destination range ('drg') in column 'A'.
    Dim drg As Range: Set drg = dws.Range("A2:A" & dlRow)
    ' Write the file name to the cells of the Destination range.
    drg.Value = sFileName
    ' Autofit Destination column.
    'drg.EntireColumn.AutoFit

End Sub

ThisWorkbook module

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    DisplayFileName Me
End Sub