Power Query Course in Spanish
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 10 of 10

Thread: Help with code

  1. #1
    Guest

    Default

    Hi, I am using the code below, pieced together using info I learned on this board, it is taking info from one sheet, by looking at the code letter in a column that the user inputs from a message box, and then adding a sheet named Code ?, Code and whatever the code letter was, it is working fine but I need help modifying the code so if the sheet is already there it will delete the old one and replace it with the new one. In the past I have used something like On Error Resume Next Sheets("Sheet Name").Delete, I thought something like Sheets("Code") & FilterCriteria .Delete would work but I can't get it to work. Thanks to all who take the time to reply.

    Sub DataMove()
    'will copy info from B1:G250,& add a sheet named code?"whatever the code was"
    Application.ScreenUpdating = False
    Dim FilterCriteria
    Dim CurrentsheetName As String
    Dim NewFileName As String
    CurrentsheetName = ActiveSheet.Name
    Range("B1:G250").Select
    Selection.AutoFilter
    FilterCriteria = InputBox("Enter the code letter you want")
    Selection.AutoFilter field:=4, Criteria1:=FilterCriteria
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets.Add
    With ActiveSheet
    'this is where the sheet is being added
    'how can I delete it if it is aready there?
    .Name = " Code " & FilterCriteria
    End With
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("C1") = "Totals"
    Range("E1") = "=sum(E3:E2500)"
    Range("F1") = "=sum(F3:F2500)"
    Cells.Select
    Selection.Columns.AutoFit
    Range("A1").Select
    Worksheets(CurrentsheetName).Activate
    Selection.AutoFilter field:=1
    Selection.AutoFilter
    Range("A1").Select
    Application.ScreenUpdating = True
    End Sub

  2. #2
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Sunny, spring-like Hull
    Posts
    3,339
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    To find out if a sheet exists and delete it if it does, add this code before your Sheets.Add statement: -

    Dim ws As Worksheet

    For Each ws In Worksheets
    If ws.Name = 'whatever' Then ws.delete
    Next ws

    You could also add an Application.DisplayAlerts = False line immediately before the If.. statement above to supress the delete sheets confirmation dialog. Set it back to True following the If.. statement.

    Hope that helps (I'm on my third beer of a very trying Saturday, so apologies if I've misinterpreted your question).

    [ This Message was edited by: Mudface on 2002-02-23 12:44 ]

  3. #3
    Guest

    Default

    Mudface, maybe one to many beers or maybe you need ONE MORE, drink one for me too. I can't get it to work I think the problem I am having is I am trying to name the sheet "code " & FilterCriteria, the code that was put in the input box, there are about 10 code letters that can be entered, I only want to delete the sheet for the code that is put in the input box, sounds confusing??. Lets see, if I have sheets named code A, and Code B and if the user inputs A in the input box it will name the sheet "Code A" I need the code to delete sheet code A and make a new one, I don't want to delete sheet code B. if the line to delete the sheet is "hard" coded I would have to have one to look for all the code sheets, A B C D , that would delete them all, I only want to delete the sheet that is put in the input box. Somehow I need it to look at what is being put in the input box and only delete that worksheet.

  4. #4
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Sunny, spring-like Hull
    Posts
    3,339
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Replace your statement Sheets.Add with

    For Each ws In Worksheets
    If ws.Name = "Code " & FilterCriteria Then ws.Delete
    Next ws
    With Sheets.Add
    .Name = "Code " & FilterCriteria
    End With

    ...should work. Drinking a beer for you as I type (badly)

  5. #5
    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

    Haven't tested your's mud, sure it works. But another way would be to have the macro call another macro. Replace your input box and delete lines with

    application.run("test_sht")

    then add the following to your vba:

    Sub test_sht()
    Application.DisplayAlerts = False
    FilterCriteria = InputBox("Enter the code letter you want")
    On Error GoTo errorhandler
    Worksheets(FilterCriteria).Select
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    errorhandler:
    With ActiveSheet
    .Name = " Code " & FilterCriteria
    End With
    End Sub

    Hope one of these approaches gets you there. Cheers,

    Nate

  6. #6
    Guest

    Default

    MudFace, That deletes the sheet but, the next thing the code does is to select A2, it is doing that on the new sheet, but I am getting and error when it tries to execute the next line, ActiveSheet.Paste. it looks to me like when it has to delete a sheet that it must be clearing the clipboard and there is nothing to paste. I tried moving it around in the Marco but still can't get it to work. I think one more beer and you will solve this one!

    Nateo your Marco renames the sheet I started on, then it gives an error because it can't find the original sheet

  7. #7
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Sunny, spring-like Hull
    Posts
    3,339
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Sorry, mate I'm brain-dead at the moment and I have to be up in a few hours. If you'd like to e-Mail me your file, I'll try and sort it out by 8 am UK time, unless someone with less alcohol and more skill would like to do it...

    e-mail address chris@mudface.freeserve.co.uk


  8. #8
    Guest

    Default

    MudFace I sent you the file, Thanks

  9. #9
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Sunny, spring-like Hull
    Posts
    3,339
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Paul, I've just sent this back to you. The new code is as below, hope it's OK and sorry for the delay.

    Option Explicit
    Dim FilterCriteria
    Dim CurrentsheetName As String
    Dim NewFileName As String
    Dim ws As Worksheet
    Dim Flag As Boolean
    Dim c

    Public Sub DataMove2()

    Flag = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    CurrentsheetName = ActiveSheet.Name
    ' Used uppercase here as there could be an error if someone inputs 'e' followed by 'E' later on
    FilterCriteria = UCase(InputBox("Enter the code letter you want"))

    ' Check the entry and exit if it doesn't appear in Column E or if it's 'nothing'

    For Each c In Range("E1:E250")
    If UCase(c.Value) = FilterCriteria Then Flag = True: Exit For
    Next c
    If Not Flag Or FilterCriteria = "" Then MsgBox "Illegal code, please re-enter": Exit Sub

    Range("B1:G250").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=4, Criteria1:=FilterCriteria
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy

    With Worksheets.Add
    .Range("A2").PasteSpecial Paste:=xlPasteAll
    .Move after:=Worksheets(Worksheets.Count)
    For Each ws In Worksheets
    If ws.Name = "Code " & FilterCriteria Then ws.Delete
    Next ws
    .Name = "Code " & FilterCriteria
    .Range("C1") = "Totals"
    .Range("E1") = "=sum(E3:E2500)"
    .Range("F1") = "=sum(F3:F2500)"
    End With

    Cells.Select
    Selection.Columns.AutoFit
    Range("A1").Select
    Worksheets(CurrentsheetName).Activate
    Selection.AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    End Sub

  10. #10
    Guest

    Default

    Mudface Thanks! It works great! Thanks for adding the things you did. Much better than my original one.

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
  •