Create Array Based On SheetName Length

  • After Creating the sheets enter the data in the newly created sheets if you want to create charts in the worksheets
  •  

     

    Public SH As Worksheet, INPUTSH As Worksheet
    Option Base 1


    Sub CreateSheets()
    rownumb = 1
    DefineInputWorksheet
    Do Until INPUTSH.Range("A" & rownumb).Value = ""
    For i = 1 To INPUTSH.Range("B" & rownumb).Value
    Set SH = Worksheets.Add(after:=Worksheets(ThisWorkbook.Worksheets.Count))
    SH.Name = INPUTSH.Range("A" & rownumb).Value & " " & i
    Next
    rownumb = rownumb + 1
    Loop
    INPUTSH.Activate
    End Sub


    Sub CreateArray_based_on_Length_Of_worksheets()
    Dim ArrayName() As String
    indexnumber = 1
    For i = 3 To ThisWorkbook.Sheets.Count
    Sheets(i).Activate
    Set SH = ActiveSheet
    If Len(SH.Name) <= 7 Then
    ReDim Preserve ArrayName(1 To indexnumber)
    ArrayName(indexnumber) = SH.Name
    indexnumber = indexnumber + 1
    End If
    Next


    DefineInputWorksheet
    For i = 1 To UBound(ArrayName)
    'MsgBox ArrayName(i)
    ThisWorkbook.Sheets(ArrayName(i)).Activate
    DefineWorksheet
    ActiveWindow.DisplayGridlines = False
    INPUTSH.Range("A1:B6").Copy SH.Range("A1")
    Application.CutCopyMode = xlCopy
    Create_Pie_Chart
    Next
    INPUTSH.Activate
    End Sub


    Sub DeleteWorksheets()
    On Error Resume Next
    Application.DisplayAlerts = False
    For i = 1 To ThisWorkbook.Sheets.Count
    Sheets(i).Activate
    DefineWorksheet
    If SH.Name <> "Introduction" And SH.Name <> "InputSheet" Then
    SH.Delete
    End If
    Next
    Application.DisplayAlerts = True
    End Sub


    Sub Create_Pie_Chart()
    Dim ch As ChartObject
    With SH.Range("E2:M22")
    Set ch = SH.ChartObjects.Add( _
    Left:=.Left, _
    Height:=.Height, _
    Width:=.Width, _
    Top:=.Top)
    End With
    With ch.Chart
    .ChartType = xlPie
    .SetSourceData SH.Range("A1:B6"), PlotBy:=xlColumns
    .SeriesCollection(1).ApplyDataLabels
    .HasLegend = True
    End With
    End Sub


    Function DefineWorksheet()
    Set SH = ActiveSheet
    End Function


    Function DefineInputWorksheet()
    Set INPUTSH = ThisWorkbook.Worksheets("InputSheet")
    End Function

    Download The Workbook