Generate sheets corresponding to row values (duplicate values exist)

Question

I have a main worksheet (Install_Input) where sheet number, test section, and material are manually entered by user.

(Below: illustration of Install_Input ws: Range A1:C8)

Sheet# | TestSection | Material

.....1.....|..........A..........|.STEEL.|

.....2.....|..........B..........|.PLASTIC.|

.....3.....|..........C..........|.STEEL.|

.....5.....|..........G..........|.STEEL.|

.....2.....|..........F..........|.PLASTIC.|

.....2.....|..........A..........|.STEEL.|

.....5.....|..........D..........|.PLASTIC.|

I want to generate sheets within the current workbook that correspond to sheet numbers entered in Install_Input. The code I made will generate a new sheet for each value in MyRange, however, I would like for my code to skip over generating sheets that already exist. I tried using the "On Error Resume Next" and "On Error GoTo 0" commands to solve this problem, but they just generated unnamed sheets to compensate for those that already exist.

Sub Consolidate_Sheets()
    Dim MyCell As Range
    Dim MyRange As Range
    Dim ws As Worksheet

    Set MyRange = Sheets("Install_Input").Range("A2")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))


    For Each MyCell In MyRange
        If Sheets(Sheets.Count).Name <> MyCell.Value Then
            'On Error Resume Next
            Sheets.Add After:=Sheets(Sheets.Count) 
            Sheets(Sheets.Count).Name = MyCell.Value 
            'On Error GoTo 0
        End If
    Next MyCell
End Sub

score 0 · Answer 1 · edited May 23 '17 at 12:12

0

You could implement a CheckSheet function like the one described in this SO answer that loops through all existing sheets and compares the name of each sheet with the passed-in value.

edited May 23 '17 at 12:12

Community

1
1

answered Jan 26 '15 at 20:45

Isaac Moses

1,589
6
26
44

score 0 · Accepted Answer · answered Jan 27 '15 at 01:50

You can use the following two functions:

    Function getSheetWithDefault(name As String, Optional wb As Excel.Workbook) As Excel.Worksheet
        If wb Is Nothing Then
            Set wb = ThisWorkbook
        End If

        If Not sheetExists(name, wb) Then
            wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)).name = name
        End If

        Set getSheetWithDefault = wb.Sheets(name)
    End Function

    Function sheetExists(name As String, Optional wb As Excel.Workbook) As Boolean
        Dim sheet As Excel.Worksheet

        If wb Is Nothing Then
            Set wb = ThisWorkbook
        End If

        sheetExists = False
        For Each sheet In wb.Worksheets
            If sheet.name = name Then
                sheetExists = True
                Exit Function
            End If
        Next sheet
    End Function

To use it in your code:

    Sub Consolidate_Sheets()
        Dim MyCell As Range
        Dim MyRange As Range
        Dim ws As Worksheet

        Set MyRange = Sheets("Install_Input").Range("A2")
        Set MyRange = Range(MyRange, MyRange.End(xlDown))

        For Each MyCell In MyRange
            If Sheets(Sheets.Count).Name <> MyCell.Value Then
                'On Error Resume Next
                set ws = getSheetWithDefault(MyCell.Value)
                'On Error GoTo 0
            End If
        Next MyCell
    End Sub

Generate sheets corresponding to row values (duplicate values exist)

2 Answers2