Macro creates unwanted duplicate sheets; Need better solution to either a) delete, or b)not even create them in the first place

bbooen

New Member
Joined
Nov 6, 2015
Messages
2
Hello!

First time VBA user, first time poster so please excuse any style issues with this post or my code (most of it is CTL V'd anyways).

Situation: I'm creating a database for tracking cases at my work. When a cell in a range gets updated, I have created a Macro to automatically create a new sheet from a template. It works well:

Sub CreateSheets()

Application.DisplayAlerts = False

Dim rng As Range
Set rng = Sheets("Summary").Range("B13:B78") '
Dim wks As Worksheet
Dim i As Long

For Each cell In rng
On Error Resume Next
If cell.Value > 0 Then
Set wks = Sheets.Add(After:=Worksheets(Worksheets.Count), Type:="C:\Users\E316416\Documents\Custom Office Templates\HWCL_template.xltm") 'CHANGE path if needed
wks.Name = cell.Value
wks.Range("A1").Value = cell.Value

End If
Next cell

End Sub

However, when I run the macro again (trying to capture additional updates in the range specified above), the code starts creating sheets called "template", "template (1), "template (2)", etc. which are repeats from the sheets that were created the first time around.

That is, I put test values 1, 2, 3, and 4 in B13:B16, and run the macro. It creates sheets from a template and names them 1, 2, 3, and 4. It's amazing. Now let's say the next day I come in and put test value 5 in B17 and run the code again. The macro will create sheets called template, template (1), template (2), template (3), before it gets to my new update sheet 5.

So my sheets appear in this order:

[1][2][3][4][template][template (1)][template (2)][template (3)][5]

I've been trying to find out how to remedy this for about a week now and finally created an account so I could ask the geniuses on this forum. The closest I got to a solution was a SheetKiller sub, but I'm pretty sure the way I have it formatted just deletes everything after the first duplicate template sheet.

Request: I either need an addition to my sub above that will skip over tabs that have already been created, or I need an addition to this SheetKiller Sub that will only delete names with "template (" in the sheet name.

Thanks. I've spent so much time on this forum and haven't quite found anything exactly like my situation.

Sub SheetKiller()
Dim i As Long
Dim j As Long
j = 0

For i = 1 To Sheets.Count
If Sheets(i).Name = "template" Then
j = i
End If
Next i

If j = 0 Or j = Sheets.Count Then Exit Sub

Application.DisplayAlerts = False
For i = Sheets.Count To j + 1 Step -1
Sheets(i).Delete
Next i
Application.DisplayAlerts = True

End Sub


I don't know how to format my code the cool way like I've seen so I apologize for that.
 

Some videos you may like

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

kalak

Active Member
Joined
Jun 10, 2015
Messages
487
You can try this. It should, if it works for you, prevent the addition of already-named sheets.
Code:
Sub CreateSheetsx()

Application.DisplayAlerts = False

Dim rng As Range
Set rng = Sheets("Summary").Range("B13:B78") '
Dim wks As Worksheet
Dim i As Long
Dim dic As Object
Set dic = CreateObject("scripting.dictionary"): dic.comparemode = 1

For Each sht In Worksheets
    If Not dic.exists(sht.Name) Then dic.Add sht.Name, Empty
Next sht

For Each cell In rng
On Error Resume Next
If cell.Value > 0 Then
    If Not dic.exists(cell.Value) Then
        Set wks = Sheets.Add(After:=Worksheets(Worksheets.Count), Type:="C:\Users\E316416\Documents\Custom Office Templates\HWCL_template.xltm") 'CHANGE path if needed
        wks.Name = cell.Value
        wks.Range("A1").Value = cell.Value
    End If
End If
Next cell

End Sub
 

bbooen

New Member
Joined
Nov 6, 2015
Messages
2
Dang I'm still having template sheets get created. Thanks for trying! Let me know if you have any other ideas I should look into.
 

kalak

Active Member
Joined
Jun 10, 2015
Messages
487
Dang I'm still having template sheets get created. Thanks for trying! Let me know if you have any other ideas I should look into.
Perhaps if you could provide a better indication of your data. By a small example perhaps.

You seem to want this:

wks.Name = cell.Value

The code I gave should ensure that a particular whole cell value, such as
Template37
cannot be used more than once to try to name a new worksheet.



 

kalak

Active Member
Joined
Jun 10, 2015
Messages
487
On reflection, it looks like may have I missed out a line. In red.
Try this modified version.
Rich (BB code):
Sub CreateSheetsxx()

'Application.DisplayAlerts = False

Dim rng As Range
Set rng = Sheets("Summary").Range("B13:B78") '
Dim wks As Worksheet
Dim i As Long
Dim dic As Object
Set dic = CreateObject("scripting.dictionary"): dic.comparemode = 1

For Each sht In Worksheets
    If Not dic.exists(sht.Name) Then dic.Add sht.Name, Empty
Next sht

For Each cell In rng
On Error Resume Next
If cell.Value > 0 Then
    If Not dic.exists(cell.Value) Then
        Set wks = Sheets.Add(After:=Worksheets(Worksheets.Count), Type:="C:\Users\E316416\Documents\Custom Office Templates\HWCL_template.xltm") 'CHANGE path if needed
        wks.Name = cell.Value
        wks.Range("A1").Value = cell.Value
        dic.Add cell.Value, Empty
    End If
End If
Next cell

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,318
Messages
5,595,454
Members
413,992
Latest member
CSEGUIN1973

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top