Error Checking in Excel
Thanks Thanks:  0
Likes Likes:  0
Page 2 of 2 FirstFirst 12
Results 11 to 18 of 18

Thread: Change file name to name in a cell

  1. #11
    Guest

    Default

    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

  2. #12
    Legend NateO's Avatar
    Join Date
    Feb 2002
    Location
    Minneapolis, Mn, USA
    Posts
    9,700
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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, NateO

    [ This Message was edited by: NateO on 2002-03-14 18:46 ]

  3. #13
    Guest

    Default

    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

  4. #14
    Board Regular
    Join Date
    Feb 2002
    Location
    Ahmedabad Gujarat
    Posts
    303
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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




  5. #15
    Guest

    Default

    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

  6. #16
    Legend NateO's Avatar
    Join Date
    Feb 2002
    Location
    Minneapolis, Mn, USA
    Posts
    9,700
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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, NateO


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

    [ This Message was edited by: NateO on 2002-03-15 14:24 ]

  7. #17
    Board Regular
    Join Date
    Mar 2002
    Location
    Orange County, California, USA
    Posts
    118
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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


  8. #18
    Legend NateO's Avatar
    Join Date
    Feb 2002
    Location
    Minneapolis, Mn, USA
    Posts
    9,700
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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, NateO

    [ This Message was edited by: NateO on 2002-03-16 15:53 ]

    [ This Message was edited by: nateo on 2002-03-16 21:44 ]

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •