Im sure its nothing more than a code line im missing. I'll try to explain what this macro is doing first and then what id like it to do. Bear in mind that as it is now is ok, it works but it doesnt work to the best efficency.
When the user clicks the "Save Record" command button. This macro checks first to see if the cell b670 is filled, if not, it pops a message and asks to have the field filled and exits, if the cell is filled, then whatever is in the cell is what the filename will be. The same thing happens for cell B672 except that cell will be the sub directory under the default path. Once that is done it saves the work book, clears the 2 cells and, returns to the SAVED sheet. So here is what its missing. 1st, it saves the WHOLE workbook and id like it to save just the active sheet called 'Order Summary' and 1 other sheet called 'Order Entry'. 2nd Id like it to save them as a copy to the main workbook I am currenty working in and have it remain in that workbook rather than revert to the copy it just saved. I can attach a copy of the workbook to look at if that will help to understand the problem a little better, for now, here is the macro code:
Code:Sub SaveAs() If Range("B670") = "" Then MsgBox ("Please fill in Boat Number.") Exit Sub ElseIf Range("B672") = "" Then MsgBox ("Please fill in Company Name.") Exit Sub End If Dim strFilename, strDirname, strPathname, strDefpath As String On Error Resume Next ' If directory exist goto next line strDirname = Range("B672").Value ' New directory name will be whatever is put into this cell strFilename = Range("B670").Value 'New file name will be whatever is in this cell strDefpath = "C:\Users\Bench\Desktop\Order Entry\" 'Default path name If IsEmpty(strDirname) Then Exit Sub If IsEmpty(strFilename) Then Exit Sub MkDir strDefpath & strDirname strPathname = strDefpath & strDirname & "\" & strFilename 'create total string ActiveWorkbook.SaveAs.Copy Filename:=strPathname, _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False For Each Cell In Range("B670:B672") If Cell > 0 Then Cell.ClearContents Next MsgBox ("Record Saved.") End Sub
the save as portion may be changed like this
Code:Sub test() Dim path As String, namefile As String path = "E:\excel\" 'change the path to suit you namefile = "tempo" 'change namefile to your wishes ActiveSheet.Copy 'tghe above is important code in this ActiveWorkbook.SaveAs path & namefile & ".xls" '.xls is for excel 2003 or earlier End Sub
There are currently 1 users browsing this thread. (0 members and 1 guests)