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.