Thread: New Sheets

Hi friends,
This problem might be simple, but it's been tedious to figure. Say there are five different values in a range of 10 cells .e.g. in range("A1:A10") there are values valueA, valueB, valueC, valueD, and valueE. this means these values get to be repeated randomly in all 10cells.
I would like to identify, with a macro, the five different values in the range, and use these values to create new 5 sheets whose tab names are those 5 values discovered in the range. The idea then is to avoid the error that occurs when you rename one sheet with a sheet name already used by another sheet.
I appreciate the help.
Bryen Walt

Can the values in A1:A10 be sorted? If so you could then just loop through them checking if the cell you are on is the same as the one above and if so not create a sheet for it.

Dom

Try this.

Sub Test()
Dim SheetFound As Boolean
Dim Cell As Range
Dim Sheet As Worksheet

For Each Cell In Range("A1:A10")
    SheetFound = False
    For Each Sheet In ActiveWorkbook.Sheets
        If Sheet.Name = Cell.Value Then
            SheetFound = True
            Exit For
        End If
    Next Sheet
    If SheetFound = False Then
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = Cell.Value
    End If
Next Cell
End Sub

Another way:

Sub x()
    Dim cell As Range

    For Each cell In Range("A1:A10")
        If Len(cell.Text) Then
            If Not SheetExists(cell.Text) Then Worksheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = cell.Text
        End If
    Next cell
End Sub

Function SheetExists(sWks As String, Optional wkb As Workbook) As Boolean
    On Error Resume Next
    SheetExists = Not IIf(wkb Is Nothing, ActiveWorkbook, wkb).Sheets(sWks) Is Nothing
End Function

Sorry for the bug. Corrected for anyone who might be interested.

Sub x()
    Dim cell As Range

    For Each cell In Range("A1:A10")
        If Len(cell.Text) Then
            If Not SheetExists(cell.Text) Then
                Worksheets.Add after:=Sheets(Sheets.Count)
                ActiveSheet.Name = cell.Text
            End If
        End If
    Next cell
End Sub

Function SheetExists(sWks As String, Optional wkb As Workbook) As Boolean
    On Error Resume Next
    SheetExists = Not IIf(wkb Is Nothing, ActiveWorkbook, wkb).Sheets(sWks) Is Nothing
End Function