VBA - for each unique value in column create a new worksheet

[kthevbaamateur]

Hi

I want to preface this by saying I am a complete vba amateur.

I am trying to make a code that makes a new worksheet for every unique value in column Z. There are a few duplicates. This is what I have so far:

Sub CreateSheets()
'Creates a sheet for each unique Sector name
Dim c As Range, sh As Worksheet
Application.ScreenUpdating = False
With Worksheets("Sheet 2").Activate
For Each c In .Range(.Range("Z2"), .Range("Z" & .Rows.Count).End(xlUp))
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = c.Value
Set sh = Nothing
Next
End With
Application.ScreenUpdating = True
End Sub

 

[Norie]

Try this.

Sub CreateSectorSheets()
Dim rng As Range
Dim cl As Range
Dim dic As Object
Dim ky As Variant

    Set dic = CreateObject("Scripting.Dictionary")
    
    With Sheets("Sheet2")
        Set rng = .Range(.Range("Z2"), .Range("Z" & .Rows.Count).End(xlUp))
    End With
    
    For Each cl In rng
        If Not dic.exists(cl.Value) Then
            dic.Add cl.Value, cl.Value
        End If
    Next cl
    
    For Each ky In dic.keys
          Sheets.Add(After:=Sheets(Sheets.Count)).Name = dic(ky)
    Next ky
    
End Sub

 

[kthevbaamateur]

Thanks! That has worked