Macro to make new sheets based on a list (Error in Code)

[yaz1069]

I know there are some threads with similar information. I have used some to come up with the following macro.
The macro is used to make a copy of a master sheet for every cell in Column A (after A2) that has data in it. It also names the sheet with the cell value and inserts the cell value in A2 on the new sheet.

The problem is that the macro is adding an extra sheet on the end (after all cells with values, it is adding one with the name:"Master (2)").

If anyone has any idea why this is the case, I would greatly appreciate an explanation.

(Sorry if my coding is atrocious, I am fairly new at VBA)

Sub CreateSheets()On Error GoTo Errorhandler
Application.ScreenUpdating = False
Application.EnableEvents = False


Dim MyCell As Range, MyRange As Range
    
    Set MyRange = Sheets("Sheet4").Range("A2")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))


    For Each MyCell In MyRange


    Sheets("Master").Copy after:=Sheets(Sheets.Count) 'COPY HIDDEN SHEET
    Sheets(Sheets.Count).Visible = True  'MAKE NEW SHEET VISIBLE
    Sheets(Sheets.Count).Name = MyCell.Value  'RENAME SHEET TO CELL VALUE
    Sheets(Sheets.Count).Range("A2").Value = Sheets(Sheets.Count).Name
   
Next MyCell
Errorhandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[Trebor76]

Hi yaz1069,

Welcome to MrExcel!!

The problem is that you're trying a tab with a name that already exists in the current workbook which as it can't be done, your code simply goes to your error handler.

You need to check for the unique characteristic of each proposed sheet name - below is one way to do this:

Option Explicit
Sub CreateSheets()

    Dim MyCell As Range, MyRange As Range
    Dim varA1Value As Variant

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Set MyRange = Sheets("Sheet4").Range("A2:A" & Sheets("Sheet4").Cells(Rows.Count, "A").End(xlUp).Row)
    
    For Each MyCell In MyRange
    
        On Error Resume Next
            Sheets(CStr(MyCell.Value)).Select
            'If the proposed sheet name cannot be selected, it mustn't exist.  Therefore we can create it.
            If Err.Number <> 0 Then
                Sheets("Master").Copy after:=Sheets(Sheets.Count) 'COPY HIDDEN SHEET
                Sheets(Sheets.Count).Name = MyCell.Value  'RENAME SHEET TO CELL VALUE
                Sheets(Sheets.Count).Range("A2").Value = Sheets(Sheets.Count).Name
            End If
            Err.Clear
        On Error GoTo 0
   
    Next MyCell
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub

Another is to create a unique array of the sheet names then create them as I have done here for ClaireJL.

HTH

Robert

 

[yaz1069]

Thank you so much Robert, for both the welcome and the help.

Your macro did almost exactly what I wanted it to.

Part of the problem was that the range with the sheet names (Sheet4) is populated from another sheet using an =cellreference formula. This is because data is pasted into one sheet and Sheet4 picks up the names from the pasted data. As the pasted data could be any number of rows, Sheet4 returns a zero value after the pasted data ends. For ease of reading, I put in the function: =IF(CellReference>0,CellReference,"") to show blank when there is no data.

This was also causing the code to add extra sheets.

I fixed this by adding this line to your code after the first IF:

If MyCell.Value <> "" Then

Once again, thanks for your help. I think I am beginning to understand more about how macros work.

 

[Trebor76]

Hi yaz1069,

Yes, I should about dealing will blank cells. There are a number of considerations (there may be more that I don't about) when naming a tab, i.e. a tab name

• Can't be longer than 31 characters in length
• Can't contain the characters : \ / ? * [ or ]
• Can't be blank (as you've discovered)
• Can't be duplicated within the same workbook
• Can't be called History

Regards,

Robert