Bill,

Building on the code that Rob provided, see if this does it for you...

'=============================================
Private blnWantToSave As Boolean

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
If blnWantToSave Then
blnWantToSave = False
Else
Dim FileSaveName As String
Dim lngPlace As Long

If MsgBox("Are sure you want to save this workbook? ", _
vbYesNo + vbQuestion, "Question from Bill") = vbNo Then
blnWantToSave = False
Cancel = True
Exit Sub
Else
Cancel = True
FileSaveName = _
Application.GetSaveAsFilename("TCR" & Cells(20, 29).Value & _
".xls",fileFilter:="Excel Files (*.xls),*.xls")
End If
'Call function
lngPlace = LASTPOSITION(FileSaveName, "\")
'Replace user specified file name with preferred name.
FileSaveName = _
Left$(FileSaveName, lngPlace) & "TCR" & Cells(20, 29).Value & ".xls"
blnWantToSave = True
ActiveWorkbook.SaveAs Filename:=FileSaveName
'Let user know you changed the file name.
MsgBox "File saved under the following name..." & vbCr _
& FileSaveName, vbInformation, "Bill Made Me Do It"
End If
End Sub

'================================================= ==========================
=============
' Counts the position in a string of a user provided character.
' Written by James Cone - September 2003.
'================================================= ==========================
=============
Function LASTPOSITION(ByRef strInput As String, _
ByRef strChar As String) As Long
On Error GoTo WrongPosition
Dim lngPos As Long
Dim lngCnt As Long
Dim lngLength As Long

lngPos = 1
lngLength = Len(strChar)

Do
lngPos = InStr(lngPos, strInput, strChar, vbTextCompare)
If lngPos Then
lngCnt = lngPos
lngPos = lngPos + lngLength
End If
Loop While lngPos 0
LASTPOSITION = lngCnt
Exit Function

WrongPosition:
Beep
LASTPOSITION = 0
End Function

'================================================= ==========================
=============
Regards,
Jim Cone
San Francisco, CA


"Bill Oertell" wrote in message
...
I'm having trouble getting this code to work. The dialog box come up and
you can navigate to the directory you want, but the file still saves to
the
original file name in the original directory.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
a = MsgBox("Are sure you want to save this workbook?", vbYesNo)
If a = vbNo Then
Cancel = True
Else
SaveAsUI = True
fileSaveName = _
Application.GetSaveAsFilename("TCR" & Cells(20, 29) &
".xls", fileFilter:="Excel Files (*.xls),*.xls")
End If
End sub

What I want to do is force the user to save the file as TCR plus whatever
is in cell AC20, ie TCRSomeone.xls, but I'd like them to be able to save it
in
the directory they choose.