vendredi 15 décembre 2017

Error with Checkbox and Duplicate Sheets

I have designed a code that creates a new worksheet based on a checkbox, and the name is derived from a User Defined Variable. However, if someone unchecks and checks the box, it runs the code again and generates an error due to multiple worksheets having the same name. I understand that this is just the code functioning as it is supposed to, but I want to create an IF:THEN statement where the code checks to see if the name exists. If the sheet exists, the code will do stop itself; if the sheet does not exist, it will run as normal.

How can I do this?

Code below.

Private Sub CheckBox4_Click()

Application.ScreenUpdating = False
Dim ws As Worksheet
Dim Protocol As Range

If CheckBox4.Value = True Then

ActiveWorkbook.Unprotect

Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
ws.Name = Sheets("Control").Cells(16, "I")
Set Protocol = Sheets("The Hidden Works").Columns("W:AQ").EntireColumn
Protocol.Copy
ws.Paste
ws.Protect
ws.EnableSelection = xlUnlockedCells
Application.CutCopyMode = False

        Worksheets("SUMMARY").Rows("44").EntireRow.Hidden = False
        Worksheets("SUMMARY").Cells(44, 3).Value = "='Control'!I16"
        Worksheets("SUMMARY").Cells(44, 3).NumberFormat = "General"
        Worksheets("SUMMARY").Cells(44, 4).Value = "='Control'!K16"
        Worksheets("SUMMARY").Cells(44, 5).Value = "='Control'!L16"
        Worksheets("SUMMARY").Cells(44, 6).Value = "=" & ws.Name & "!$H$69"
        Worksheets("SUMMARY").Cells(44, 7).Value = "=" & ws.Name & "!$J$69"
        Worksheets("SUMMARY").Cells(44, 8).Value = "=" & ws.Name & "!$N$69"
        Worksheets("SUMMARY").Cells(44, 9).Value = "=" & ws.Name & "!$P$69"
        Worksheets("SUMMARY").Cells(44, 10).Value = "=SUM(F44:I44)/D44"
        Worksheets("SUMMARY").Cells(44, 11).Value = "=M44/F3"
        Worksheets("SUMMARY").Cells(44, 12).Value = "=" & ws.Name & "!$U$69"
        Worksheets("SUMMARY").Cells(44, 13).Value = "=M44/$K$57"

Worksheets("Control").Activate

End If
    Application.ScreenUpdating = True
End Sub




Aucun commentaire:

Enregistrer un commentaire