Create Array Based On SheetName Length
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