none
VBA code to create sheet for each unique value in a specific column RRS feed

  • Question

  • Dear Developers! 

    I would like to seek your help in creating a macro that will enable me to create separate sheets for each unique value in one of my column. The scenario is, I have Col W with different values, (some rows will be empty). And for each unique value starting in row 2, it will create a new sheet. here's what I have started so far: 

    Dim c As Range, sh As Worksheet
    With ActiveSheet
        For Each c In .Range("W2", .Cells(Rows.count, 1).End(xlUp))
            Set sh = Sheets.Add(After:=Sheets(Sheets.count))
            sh.Name = c.Value
            Set sh = Nothing
        Next
    End With

    Thank you! 

    Monday, October 16, 2017 5:52 PM

Answers

  • For example:

    Sub CreateSheets()
        Dim c As Range, sh As Worksheet, s As String
        Application.ScreenUpdating = False
        With ActiveSheet
            For Each c In .Range(.Range("W2"), .Range("W" & .Rows.Count).End(xlUp))
                s = c.Value
                If s <> "" Then
                    On Error Resume Next
                    Set sh = Sheets(s)
                    On Error GoTo 0
                    If sh Is Nothing Then
                        Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
                        sh.Name = s
                    End If
                    Set sh = Nothing
                End If
            Next c
        End With
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by IamJackie Monday, October 16, 2017 9:22 PM
    Monday, October 16, 2017 8:45 PM

All replies

  • For example:

    Sub CreateSheets()
        Dim c As Range, sh As Worksheet, s As String
        Application.ScreenUpdating = False
        With ActiveSheet
            For Each c In .Range(.Range("W2"), .Range("W" & .Rows.Count).End(xlUp))
                s = c.Value
                If s <> "" Then
                    On Error Resume Next
                    Set sh = Sheets(s)
                    On Error GoTo 0
                    If sh Is Nothing Then
                        Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
                        sh.Name = s
                    End If
                    Set sh = Nothing
                End If
            Next c
        End With
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by IamJackie Monday, October 16, 2017 9:22 PM
    Monday, October 16, 2017 8:45 PM
  • Thank you so much! It worked! :D 
    Monday, October 16, 2017 9:23 PM