"Save As" macro using a cell's value

This should do it. You need to add this code to a
module in the Visual Basic Editor. Access the editor
from Tools\Macro\Visual Basic Editor.

In the editor select Insert\Module.

Paste the code there.

From Excel Run the code from Tools\Macro\Macros\SaveSheet
select Run

The help files can explain how to attach the code
to a button or short cut key. You might also check out
how to make the code available all the time (open in
the background with Excel.

Sub SaveSheet()
'error trap
On Error GoTo Etrap

Dim MyCell
MyCell = ActiveCell.Value

'ask user to save
If MsgBox("Save new workbook as " & CurDir & "\" & MyCell & ".xls?", vbYesNo) = vbNo Then
Exit Sub
End If

'check value of activecell
If MyCell = "" Then
MsgBox "Please check the Cell Value", vbInformation
Exit Sub
End If

'save activeworkbook as new workbook
ActiveWorkbook.SaveAs Filename:=MyCell & ".xls", _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False

Etrap:

Beep
Exit Sub

End Sub

Almost got it....

'ask user to save If MsgBox("Save new workbook as " & CurDir & "\" & MyCell & ".xls?", vbYesNo) = vbNo Then Exit Sub End If 'check value of activecell If MyCell = "" Then MsgBox "Please check the Cell Value", vbInformation Exit Sub End If 'save activeworkbook as new workbook ActiveWorkbook.SaveAs Filename:=MyCell & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False Beep Exit Sub

Ok, I've got the module made, got the code pasted and even got it assigned to a menu button. However, it asks me if I want to save, I click yes and it doesn't save. I've tried running it with many different dates and it's not saving it anywhere that I can find it. Any clues? and by the way many thanks so far...

It's the date format

'ask user to save If MsgBox("Save new workbook as " & CurDir & "\" & MyCell & ".xls?", vbYesNo) = vbNo Then Exit Sub End If 'check value of activecell If MyCell = "" Then MsgBox "Please check the Cell Value", vbInformation Exit Sub End If 'save activeworkbook as new workbook ActiveWorkbook.SaveAs Filename:=MyCell & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False Beep Exit Sub

I've got it narrowed down to the fact that it's trying to save a date and excel won't allow a date format of 2/1/02 or for that matter any other date format to be saved. Any clues?

Format the cell in question as TEXT then enter the date as 1FEB2002 then the save as works fine.

Rick

Re: It's the date format

Hi Don,

You can't save a file using illegal characters like / and \...(I know some other illegal characters at work...just kidding.)

Try this if you like...

1.) select the cell with your date reference, then go to menu command 'Format | Cells...' and select the 'Number' tab from the 'Format Cells' dialog box, then select 'Date' from the listbox.

2.) change the date format to ANYTHING BUT dates using '/' characters in them (i.e. '02-01-2002', '02_01_2002', 'February 1, 2002', etc.), then click 'OK.' If you know how to create a custom format, then you can do that too...just don't use anything with '/'.

3.) cut and paste the code below into a module in your project...you can run it manually or assign a macro button to run it. (Be sure and change the values where noted to fit your project.)

Sub SaveFileAsDate()
Dim WSName As String, CName As String, Directory As String, savename As String
''''''''''''''''''''CHANGE THE NEXT 3 LINES TO FIT YOUR NEEDS'''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
WSName = "Sheet1"
'change "Sheet1" to sheet tab name containing cell reference
CName = "A1"
'change "A1" to the cell with your date
Directory = "C:\My Documents\"
'directory you want to save to--(make sure string ends with forward slash \)
'...to save to default directory change to "" (Null)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
savename = Sheets(WSName).Range(CName).Text
If Directory = "" Then Directory = CurDir

On Error GoTo errorsub:
ActiveWorkbook.SaveAs FileName:=Directory & savename & ".xls"
Exit Sub

errorsub:
Beep
MsgBox "Changes not saved!", vbExclamation, Title:=savename & ".xls"
End Sub

Yes, the date will still show up in the formulabar with '/' in them, but the worksheet will display the date format you selected--(the .text in the vba code will read the text as it is displayed in your worksheet). Not real professional, but it works.

Hope it helps...rm

correction...

...sorry, use this code instead of last...

Sub SaveFileAsDate()
Dim WSName As String, CName As String, Directory As String, savename As String
''''''''''''''''''''CHANGE THE NEXT 3 LINES TO FIT YOUR NEEDS'''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
WSName = "Sheet1"
'change "Sheet1" to sheet tab name containing cell reference
CName = "A1"
'change "A1" to the cell with your date
Directory = "C:\My Documents\"
'directory you want to save to--(make sure string ends with forward slash \)
'...to save to default directory change to "" (Null)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
savename = Sheets(WSName).Range(CName).Text
If Directory = "" Then Directory = CurDir & "\"

On Error GoTo errorsub:
ActiveWorkbook.SaveAs FileName:=Directory & savename & ".xls"
Exit Sub

errorsub:
Beep
MsgBox "Changes not saved!", vbExclamation, Title:=savename & ".xls"
End Sub

Yahooooo !!

Many, many, many thanks!!!!!! It works perfectly!!!