Excel: Have File saved from name found in specific cell


I found this code on another site and it works fine as it is. What is needed to have it look at in worksheet Inventory in cell B42 rather than having to enter the name?


Option Explicit
 
Sub KillPreviousFile()
    Dim szMsgResponse As String
     
     '   Get the name of this workbook with out the .xlsm
    Dim szDefaultName As String
    szDefaultName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
     
     
StartAgain:
     '   Use an input box to obtain the new file name:
    Dim szNewBookName As String
    szNewBookName = InputBox("Please enter a name for the new file" & _
    vbNewLine & _
    "It will be saved in the same directory as the original" & vbNewLine & _
    vbNewLine & _
    "Valid file-names cannot include these characters" & vbNewLine & _
    "< > \ / * ? | : ; """, , szDefaultName)
     
     
     '   If a name has been specified:
    If szNewBookName <> Empty Then
         
         
         '       Suppress messages
        Application.DisplayAlerts = False
         
         
         '       Determine old workbooks path and name and store for later use
        Dim szOldBook As String
        szOldBook = ThisWorkbook.FullName
         
         
         '       Create a valid path for our new file, same directory as this file
        Dim szThisPath As String
        szThisPath = ThisWorkbook.Path & "\"
         
         
         '       Build our new file name
        Dim szNewFileName As String
        szNewFileName = szThisPath & szNewBookName & ".xlsm"
         
         
         '       If the user typed in the same name as the original, we have some options
         '       we can present, by either starting the procedure over, saving the file,
         '       or canceling the procedure entirely
        If szNewFileName = szOldBook Then
             
             
             '           Variable szMsgResponse holde the msgbox button press:
            szMsgResponse = MsgBox("The new file name is the same as the original" & _
            vbNewLine & "Would you like to save now, try again, or cancel?", 19)
             
             '           Proceed based on the selected option
            Select Case szMsgResponse
            Case 2
                Exit Sub
            Case 7
                GoTo StartAgain
            Case 6
                ThisWorkbook.Save
                Exit Sub
            End Select
             
             
        End If
         
         
         '       If we are valid, save this file under the new name:
        On Error GoTo ExitProc
        ThisWorkbook.SaveAs szNewFileName, xlWorkbookNormal
         
         
         '       Then remove the old workbook we just were using
        Kill szOldBook
         
         
    Else
         
         
         '       if nothing was given in the input box, just exit.
        Exit Sub
         
    End If
     
ExitProc:
    Application.DisplayAlerts = True
    Exit Sub
     
InvalidName:
    MsgBox Err.Description
    GoTo ExitProc
End Sub


This question generated 13 answers. To proceed to the answers, click here.

This thread is current as of August 01, 2017.


For more resources for Microsoft Excel