Change file name to name in a cell

[Guest]

GOAL: Have an Excel file renamed automatically using the contents of a cell in the first sheet.
DETAILS: The cell with the new file name is always Y1. The cell is blank initially (although it doesn't have to be).
OTHER INFO: OS= WIN 98 Excel= 2000 I'm new to VBA and macros.
EXAMPLE: If I input "STEVE C" into cell Y1, the name of the file will be STEVE C.xls
(I am not worried about the case in the file name itself. It would, however, be a benifit to have the contents of Y1 be all uppercase automatically - if that is also possible.)

Thank you for your help. This is the first time I've been here.
Steve C

 

[Guest]

THANK YOU NATE!
I don't know VBA but I was able to figure out where to put the 3 lines. Absolutly amazing. Just send me any questions that are too difficult for you. lol
Thanks again!
SteveC

 

[NateO]

SteveC, glad to hear it's functional! All's well that ends well. I appreciate the offer, I may need to take you up on that.

Good Hunting!

_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue">O</font></font></font>
This message was edited by NateO on 2002-03-14 18:46

 

[Guest]

UH OH! I found a problem! I'm almost there -except for this error. Thank you for any help. (If it isn't OK to list all the code like I did below, tell me & I won't do it again.) -SteveC
PROBLEM: When I delete from or paste to: 1) any cells that are bordered by a full side (not diagonal)....or 2) any merged cells.... 3) in the first sheet only -which is the only sheet I have macros in) I get a Visual Basic error called.... Run-time error "13": Type mismatch....
When I select the debug button it highlights the line:....
If Target = Range("AI1") Then....
The full code is below.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
___Dim Path As String ' path of current worksheet
___Dim ThisFileNew As String ' new file name including path
___Dim Resp As Integer ' user response to overwrite query
___Dim i As Integer ' rename workSHEETS
___Dim fname As String ' to del old file (frm Nate O 031202)
___fname = ActiveWorkbook.FullName ' to del old file (frm Nate O 031202)

___If Target = Range("AI1") Then ' rename workSHEETS
_____For i = 1 To Worksheets.Count ' rename workSHEETS
_______Worksheets(i).Name = Target.Value + i - 1 ' rename workSHEETS
_____Next
___End If
___If Not Intersect(Target(1), Range("Y1")) Is Nothing Then
_______With Application
___________.EnableEvents = False
___________.DisplayAlerts = False
_______End With
_______On Error Resume Next
' Set cell contents (file name) to upper case
_______Target.Value = UCase(Target.Text)
' Get current path (empty if workbook has never been saved)
_______Path = ThisWorkbook.Path
_______If Not Path = "" Then Path = Path & ""
_______ThisFileNew = Path & Target.Text & ".xls"
_______Resp = vbOK
' Check for existing file of same name and, if present, ask whether to overwrite
_______With Application.FileSearch
___________.NewSearch
___________.LookIn = ThisWorkbook.Path
___________.SearchSubFolders = False
___________.Filename = Target.Text & ".xls"
___________.MatchTextExactly = False
.FileType = msoFileTypeAllFiles
___________If .Execute() > 0 Then
_______________Resp = MsgBox("This file already exists. Overwrite? ", vbExclamation + vbOKCancel)
___________End If
_______End With
' Save the workbook if file does not exist, or if user wants to overwrite it
_______If Resp = vbOK Then
___________ActiveWorkbook.SaveAs Filename:=ThisFileNew
___________Kill fname ' to del old file (frm Nate O 031202)
_______Else
___________Resp = MsgBox("You will need to rename this file manually", vbInformation)
_______End If

_______On Error GoTo 0
_______With Application
___________.DisplayAlerts = True
_______.EnableEvents = True
_______End With
___End If
End Sub

 

[nisht]

You can do this by following procedure.

Sub workbooksave()
' to make a save in current working folder
' use below code
'ThisWorkbook.SaveAs Worksheets("sheet4").Range("a1").Text
' -------------------------------
' If you want to saveas in different folder then give the
' complete path and dont forget to put back slash
' at the end of the folder where you want to change
' the folder otherwise file will be save with the
' last word and the filename suggested
    ThisWorkbook.SaveAs "d:myback" & Worksheets("sheet4").Range("a1").Text
 End Sub 


you can use upper, lower or proper functions to make appearance of text.

say you can improve your code..

ni****h desai
http://www.pexcel.com

 

[Guest]

Nisht,
I'm sorry but I don't understand (I'm new at this.). Does this mean that you think that the problem is from the way that the file is being saved? Also, could you tell me where to put the lines that you suggest and should any lines be deleted?
Thank you.
SteveC

 

[NateO]

StevieC, What if you add an errorhandler like below:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Path As String ' path of current worksheet
Dim ThisFileNew As String ' new file name including path
Dim Resp As Integer ' user response to overwrite query
Dim i As Integer ' rename workSHEETS
Dim fname As String ' to del old file (frm Nate O 031202)
fname = ActiveWorkbook.FullName ' to del old file (frm Nate O 031202)

On Error GoTo errorhandler
If Target = Range("AI1") Then ' rename workSHEETS
For i = 1 To Worksheets.Count ' rename workSHEETS
Worksheets(i).Name = Target.Value + i - 1 ' rename workSHEETS
Next
End If
If Not Intersect(Target(1), Range("Y1")) Is Nothing Then
With Application
.EnableEvents = False
.DisplayAlerts = False
End With
On Error Resume Next
' Set cell contents (file name) to upper case
Target.Value = UCase(Target.Text)
' Get current path (empty if workbook has never been saved)
Path = ThisWorkbook.Path
If Not Path = "" Then Path = Path & ""
ThisFileNew = Path & Target.Text & ".xls"
Resp = vbOK
' Check for existing file of same name and, if present, ask whether to overwrite
With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path
.SearchSubFolders = False
.Filename = Target.Text & ".xls"
.MatchTextExactly = False
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
Resp = MsgBox("This file already exists. Overwrite? ", vbExclamation + vbOKCancel)
End If
End With
' Save the workbook if file does not exist, or if user wants to overwrite it
If Resp = vbOK Then
ActiveWorkbook.SaveAs Filename:=ThisFileNew
Kill fname ' to del old file (frm Nate O 031202)
Else
Resp = MsgBox("You will need to rename this file manually", vbInformation)
End If

On Error GoTo 0
With Application
.DisplayAlerts = True
.EnableEvents = True
End With
End If
errorhandler:
End Sub

Hope this helps.

_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue">O</font></font></font>


P.S. -Incidentally all, happy St. Patty's Day!

This message was edited by NateO on 2002-03-15 14:24

 

[SteveC]

NATE,
Thank you again! It worked perfectly -of course.
You have a fantastic skill and knowledge: Do you do this for a living?
Steve Cole

 

[NateO]

Thanks for the Kudos Steve. Glad to hear this is working well for you.

I actually do lots of things for a living, skiing, reading, slo-pitch softball.....My professional occupation is a long story, a combination of buying companies, cost accounting and in-house information systems work (E.g., GL interaction automation and custom applications). It's a nice blend of finance & technology projects.

Have a great weekend.

_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue">O</font></font></font>
This message was edited by NateO on 2002-03-16 15:53
This message was edited by nateo on 2002-03-16 21:44