Macro to autogenerate sheets based on unique values of a listClosed

Question

Hello! 

I would greatly appreciate if anyone could help me with a macro. I have a number of populated rows in one sheet (Sheet A) and one of the columns contains a drop-down list. Now, I would like a macro to autogenerate sheets with the names of each sheet corresponding to the name on the list. HOWEVER, the catch is that the column in sheet A will end up with a couple of rows with duplicate names. In other words, if we consider the column to be J, J12 might be named 'Pipes', J13 could be 'Plates', and J14 could again be 'Pipes'. 

Now, how do you think the following code could be tweaked in such a way that the macro gets executed without a hitch? 

Sub CreateSheetsFromAList() 
Dim MyCell As Range, MyRange As Range 

Set MyRange = Sheets("SheetA").Range("J12") 
Set MyRange = Range(MyRange, MyRange.End(xlDown)) 

For Each MyCell In MyRange 
Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet 
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet 
Next MyCell 
End Sub 

Thanks a lot for your help on this. 

BR, 
Hack

TrowaD · Answer

Hi Hack,

The code below will check if the sheet name is already applied. If so then delete the unnamed sheet and continue loop.

Here is the amended code:
Sub CreateSheetsFromAList()
Dim MyCell, MyRange As Range
Dim DeleteSh As Boolean
Dim sh As Worksheet

Set MyRange = Sheets("SheetA").Range("J12")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

For Each MyCell In MyRange
    Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
    For Each sh In Worksheets
        If sh.Name = MyCell.Value Then DeleteSh = True
    Next sh
    If DeleteSh = True Then
        Application.DisplayAlerts = False
        ActiveSheet.Delete
        Application.DisplayAlerts = True
    Else:
        Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
    End If
    DeleteSh = False
Next MyCell

End Sub

Best regards,
Trowa  
 
Monday, Tuesday and Thursday are usually the days I'll respond. Bear this in mind when awaiting a reply.

Macro to autogenerate sheets based on unique values of a list

1 response

Similar discussions

Subscribe To Our Newsletter!