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?
Code:
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
