VBA to avoid duplicate sheet

[Shadkng]

Hi, the below code creates a new sheet "PARTS_LIST_CLUTCH." Sometimes I have to run the code again and I get a debug because the sheet name already exists. Is it tpossible to delete the sheet and re-create it? Or if we could just overwrite it that would be fine too. Thanks for the help.

Sub PARTS_LIST_CLUTCH()  'steve added 10-26-21
Application.ScreenUpdating = False

If Sheets("FINALORDER").Range("B23").Value = "SR" Then '10/17/2019 - Added "SR" Condition
    Exit Sub
    Else
End If

Sheets("PARTS LIST").Copy after:=Sheets("PARTS LIST")
ActiveSheet.Name = "PARTS LIST CLUTCH"
Range("A7:F300").Clear
Range("E1:F5").Clear
ActiveSheet.Buttons.Delete

Worksheets("PARTS LIST").Range("E7:F50").Copy
Worksheets("PARTS LIST CLUTCH").Range("A11").PasteSpecial


Range("A1") = "** PARTS LIST CLUTCH ASSEMBLY **"
Range("A8") = "PACKED BY:________________"
Range("A6").HorizontalAlignment = xlLeft
Range("A6") = "DATE:________________"
Range("C8") = "CHECKED BY:________________"
Range("a1").Font.Size = 24
Columns("A:A").AutoFit
Columns("C:C").AutoFit
Columns("A:A").ColumnWidth = Columns("A:A").ColumnWidth + 1
Columns("B:B").HorizontalAlignment = xlCenter
Range("A10").Select

Application.ScreenUpdating = True

End Sub

 

[Fluff]

If you don't want that cleared everytime , you can move it into the If statement, like

Sub PARTS_LIST_CLUTCH()  'steve added 10-26-21
Application.ScreenUpdating = False
 Dim Sht As Worksheet
If Sheets("FINALORDER").Range("B23").Value = "SR" Then '10/17/2019 - Added "SR" Condition
    Exit Sub
    Else
End If
If Not Evaluate("isref('PARTS LIST CLUTCH'!a1)") Then
   Sheets("PARTS LIST").Copy after:=Sheets("PARTS LIST")
   ActiveSheet.Name = "PARTS LIST CLUTCH"
   With Sheets("PARTS LIST CLUTCH")
      .Range("A7:F300").Clear
      .Range("E1:F5").Clear
      .Buttons.Delete
   End With
Else
   Sheets("PARTS LIST CLUTCH").UsedRange.Clear
End If
With Sheets("PARTS LIST CLUTCH")
   Worksheets("PARTS LIST").Range("E7:F50").Copy
   .Range("A11").PasteSpecial


   .Range("A1") = "** PARTS LIST CLUTCH ASSEMBLY **"
   .Range("A8") = "PACKED BY:________________"
   .Range("A6").HorizontalAlignment = xlLeft
   .Range("A6") = "DATE:________________"
   .Range("C8") = "CHECKED BY:________________"
   .Range("a1").Font.Size = 24
   .Columns("A:A").AutoFit
   .Columns("C:C").AutoFit
   .Columns("A:A").ColumnWidth = Columns("A:A").ColumnWidth + 1
   .Columns("B:B").HorizontalAlignment = xlCenter
End With

Application.ScreenUpdating = True

End Sub

 

[Shadkng]

If you don't want that cleared everytime , you can move it into the If statement, like

Sub PARTS_LIST_CLUTCH()  'steve added 10-26-21
Application.ScreenUpdating = False
 Dim Sht As Worksheet
If Sheets("FINALORDER").Range("B23").Value = "SR" Then '10/17/2019 - Added "SR" Condition
    Exit Sub
    Else
End If
If Not Evaluate("isref('PARTS LIST CLUTCH'!a1)") Then
   Sheets("PARTS LIST").Copy after:=Sheets("PARTS LIST")
   ActiveSheet.Name = "PARTS LIST CLUTCH"
   With Sheets("PARTS LIST CLUTCH")
      .Range("A7:F300").Clear
      .Range("E1:F5").Clear
      .Buttons.Delete
   End With
Else
   Sheets("PARTS LIST CLUTCH").UsedRange.Clear
End If
With Sheets("PARTS LIST CLUTCH")
   Worksheets("PARTS LIST").Range("E7:F50").Copy
   .Range("A11").PasteSpecial


   .Range("A1") = "** PARTS LIST CLUTCH ASSEMBLY **"
   .Range("A8") = "PACKED BY:________________"
   .Range("A6").HorizontalAlignment = xlLeft
   .Range("A6") = "DATE:________________"
   .Range("C8") = "CHECKED BY:________________"
   .Range("a1").Font.Size = 24
   .Columns("A:A").AutoFit
   .Columns("C:C").AutoFit
   .Columns("A:A").ColumnWidth = Columns("A:A").ColumnWidth + 1
   .Columns("B:B").HorizontalAlignment = xlCenter
End With

Application.ScreenUpdating = True

End Sub

Hi Fluff, I went back to my original code below and added 3 lines (see bold) that I got on the web. I guess it's deleting the "PARTS LIST CLUTCH" every time which is fine and my code is just recreating it. This seems to be working, except I get a pop up box confirming if I want to delete. Maybe we can go this route and you can fix the code or sub something in. Thanks

sub PARTS_LIST_CLUTCH()  'steve added 10-26-21
Application.ScreenUpdating = False

If Sheets("FINALORDER").Range("B23").Value = "SR" Then '10/17/2019 - Added "SR" Condition
    Exit Sub
    Else
End If

[B]On Error Resume Next
    ThisWorkbook.Worksheets("PARTS LIST CLUTCH").Delete
    On Error GoTo 0[/B]


Sheets("PARTS LIST").Copy after:=Sheets("PARTS LIST")
ActiveSheet.Name = "PARTS LIST CLUTCH"
Range("A7:F300").Clear
Range("E1:F5").Clear
ActiveSheet.Buttons.Delete

Worksheets("PARTS LIST").Range("E7:F50").Copy
Worksheets("PARTS LIST CLUTCH").Range("A11").PasteSpecial


Range("A1") = "** PARTS LIST CLUTCH ASSEMBLY **"
Range("A8") = "PACKED BY:________________"
Range("A6").HorizontalAlignment = xlLeft
Range("A6") = "DATE:________________"
Range("C8") = "CHECKED BY:________________"
Range("a1").Font.Size = 24
Columns("A:A").AutoFit
Columns("C:C").AutoFit
Columns("A:A").ColumnWidth = Columns("A:A").ColumnWidth + 1
Columns("B:B").HorizontalAlignment = xlCenter
Range("A10").Select

Application.ScreenUpdating = True

End Sub

 

[Fluff]

What's wrong with the code in post#11?

 

[Shadkng]

What's wrong with the code in post#11?

It ran OK the first time, but the 2nd time I lost data at the top of the form and the formatting was off. I found the below code which works perfectly so far.

Application.DisplayAlerts = False
On Error Resume Next
    ThisWorkbook.Worksheets("PARTS LIST CLUTCH").Delete
    On Error GoTo 0
Application.DisplayAlerts = True

 

[Fluff]

Glad you sorted it & thanks for the feedback.