Check for sheets with a given name and prompt the user to delete it

Question

So I've made a piece of code to copy an existing sheet into a new sheet and name it, based on some options chosen in the original sheet.

The problem is that if a sheet named "Example 1" already exists, and the original sheet is asked to create a new sheet and name it "Example 1" then the program runs into an error.

I've tried to get around this problem by adding a loop that checks all the worksheets for the given name, and if it exists asks the user if it should be deleted or not.

If the user wants it deleted, then it is deleted and a new version of the sheet is created with the same name. If not, then the program ends.

That alone works fine and dandy, but if the program does NOT find a sheet with the same name as the one I'm creating, then nothing happens.

The code is as follows

Sub TestForArk()
'Modul til at kopiere Indleveringsplanen som den er, og gøre det nye ark uafhængigt af ændringer i Indleveringsplanen

Dim wb As Workbook
Dim ws As Worksheet

Set wb = ActiveWorkbook

Sheets("Indleveringsplan").Unprotect
'Låser op for indleveringsplanen

    For Each ws In wb.Worksheets
        If ws.Name = "Indleveringsplan (2)" Then
            Application.DisplayAlerts = False
            Sheets("Indleveringsplan (2)").Delete
            Application.DisplayAlerts = True
        End If
    Next

    Sheets("Indleveringsplan").Copy Before:=Sheets(2)
    'Kopierer indleveringsplanen for at få den rette opsætning

    For Each ws In wb.Worksheets
        If ws.Name = ("Indleveringsplan " & Range("L3")) Then
            If MsgBox("Der findes allerede et ark for det valgte produkt, ønsker du at slette det gamle ark og oprette et nyt?", _
            vbYesNo, "Ark med samme navn fundet") = vbYes Then
                Application.DisplayAlerts = False
                Sheets("Indleveringsplan " & Range("L3")).Delete
                Application.DisplayAlerts = True
                Module1.Kopier_Ark
            Else
                Application.DisplayAlerts = False
                Sheets("Indleveringsplan (2)").Delete
                Application.DisplayAlerts = True
                MsgBox "Arket blev ikke oprettet", Title:="Handling Annuleret"
            End If
        End If
        Next
    Sheets("Indleveringsplan").Protect
    'Låser indleveringplanen igen
    End Sub

I realise that nothing happens because I haven't added any code for it to do so, but all my attempts so far have resulted in errors or screwed up what worked before.

This is my most functional attempt so far.

Variatus · Answer 1 · 2017-04-21T15:13:50.287

0

Actually, the way you tried is the hard way. The easy way is the other way around. Just try to set the worksheet as if it exists. If it doesn't exist, an error will occur, in which case you create it.

Private Sub ActivateWorksheet()

    Dim Wb As Workbook
    Dim Ws As Worksheet

    Set Wb = ThisWorkbook
    On Error Resume Next
    Set Ws = Wb.Worksheets("Example1")
    If Err Then
        Set Ws = Wb.Worksheets.Add(After:=Wb.Sheets(Wb.Sheets.Count))
        Ws.Name = "Example1"
    End If
    On Error GoTo 0
End Sub

Here is a variation of the above theme. The function SheetExists will return True or False in answer of that question.

Private Sub TestSheetExists()
    Debug.Print SheetExists("Example1")
End Sub

Private Function SheetExists(WsName As String) As Boolean

    Dim Ws As Worksheet

    On Error Resume Next
    Set Ws = Worksheets(WsName)
    SheetExists = Not CBool(Err)
    Err.Clear
End Function

edited Apr 21 '17 at 15:13

answered Apr 21 '17 at 14:39

Variatus

14,293
2
14
30

First of all, I need it to copy the original sheet in order for the cells to have the same dimensions as in the original sheet. It's also important that if the sheet does exist, then the user has the option to delete it and create the new sheet instead. Finally I need to be able to name it "Example" & Range("L3"), which it would seem I'm not allowed to with that setup – Christian Emil Johansen Apr 21 '17 at 15:01
The function I added to my above answer can accept any string. It doesn't matter how you create it. It will tell you definitely whether a sheet exists or not. I understand that the rest of your code works fine and dandy. Therefore I am confident that your problem should be solved. – Variatus Apr 21 '17 at 15:19
I'll see if I can make it work. I know that the way I've done it is likely a real programmers nightmare. Be glad you can't see the rest of my code, because there is a LOT and it is likely also quite crude – Christian Emil Johansen Apr 21 '17 at 15:24

score 0 · Accepted Answer · edited May 23 '17 at 11:54

A working variant of the original code, crude as it may be.

Got the idea from user fbonetti on this question https://stackoverflow.com/a/15668661/7780010

Sub TestForArk()
'Modul til at kopiere Indleveringsplanen som den er, og gøre det nye ark uafhængigt af ændringer i Indleveringsplanen

Dim wb As Workbook
Dim ws As Worksheet
Dim exists As Boolean

Set wb = ActiveWorkbook
Sheets("Indleveringsplan").Unprotect
'Låser op for indleveringsplanen

    For Each ws In wb.Worksheets
        If ws.Name = "Indleveringsplan (2)" Then
            Application.DisplayAlerts = False
            Sheets("Indleveringsplan (2)").Delete
            Application.DisplayAlerts = True
        End If
    Next

    Sheets("Indleveringsplan").Copy Before:=Sheets(2)
    'Kopierer indleveringsplanen for at få den rette opsætning

    For Each ws In wb.Worksheets
        If ws.Name = ("Indleveringsplan " & Range("L3")) Then
            exists = True
        End If
    Next

    If exists Then
        If MsgBox("Der findes allerede et ark for det valgte produkt, ønsker du at slette det gamle ark og oprette et nyt?", _
        vbYesNo, "Ark med samme navn fundet") = vbYes Then
            Application.DisplayAlerts = False
            Sheets("Indleveringsplan " & Range("L3")).Delete
            Application.DisplayAlerts = True
            Module1.Kopier_Ark
        Else
            Application.DisplayAlerts = False
            Sheets("Indleveringsplan (2)").Delete
            Application.DisplayAlerts = True
            Sheets("Indleveringsplan").Activate
            MsgBox "Arket blev ikke oprettet", Title:="Handling Annuleret"
        End If
    Else
        Module1.Kopier_Ark
    End If

Sheets("Indleveringsplan").Protect
'Låser indleveringplanen igen

End Sub

score 0 · Answer 3 · answered May 08 '18 at 08:47

0

Just a structure of the code that worked for me.

On Error GoTo Sheet_add:
Set wSheet = NewWorkbook.Sheets(NewSheetname)
GoTo Sheet_Exists
Sheet_add:
    NewWorkbook.Activate
    Sheets.Add
    ActiveSheet.Name = NewSheetname

Sheet_Exists:

answered May 08 '18 at 08:47

Vikash Singh

111
4

Check for sheets with a given name and prompt the user to delete it

3 Answers3