Create Chart Based on Items and Years Bifurcation
Public SH As Worksheet, NewSh As Worksheet
' Define Public variables
Sub ShowUserForm()
'Disable Display alerts
Application.DisplayAlerts = False
DeleteWorksheets ' Create Function to delete existing worksheets other than Introduction,Data
DefineWorksheet 'Define data worksheet
LastRow = DefineLastRow 'Find Last row in Data worksheet
'Identify the Unique records using countif function and add to Listbox
For r = 2 To LastRow 'Using for Loop
'Find unique values and add to userform using COUNTIF function
If Application.WorksheetFunction.CountIf(Range("B2:B" & r), Range("B" & r)) = 1 Then
UserForm1.ListBox1.AddItem Range("B" & r).Value
End If
'Add the Years in column D
SH.Range("D" & r).Value = Year(SH.Range("A" & r))
'Identify the unique records by using CountIF function
If Application.WorksheetFunction.CountIf(Range("D2:D" & r), Year(Range("A" & r))) = 1 Then
UserForm1.ListBox3.AddItem Year(Range("A" & r).Value)
End If
Next
'Add Function to Userform
UserForm1.ListBox2.AddItem "Count"
UserForm1.ListBox2.AddItem "Sum"
UserForm1.ListBox2.AddItem "Average"
UserForm1.ListBox2.AddItem "Mean"
UserForm1.ListBox2.AddItem "Max"
UserForm1.ListBox2.AddItem "Min"
SH.Range("D2:D" & LastRow).Clear
UserForm1.Show
Application.DisplayAlerts = True
End Sub
Sub Create_Chart()
'Find the function name
For F = 0 To UserForm1.ListBox2.ListCount - 1
If UserForm1.ListBox2.Selected(F) = True Then
FunctionName = UserForm1.ListBox2.List(F, 0)
Exit For ' as this listbox enables single selection only. Hence i used Exit For
End If
Next
'External Loop for Items
For ItemsLoop = 0 To UserForm1.ListBox1.ListCount - 1
If UserForm1.ListBox1.Selected(ItemsLoop) = True Then ' If condition for Item selection
AddNewWorksheet 'Add New worksheet
'Item selected in Listbox
NewSh.Name = UserForm1.ListBox1.List(ItemsLoop, 0) 'Provide the Name to the Newly crated sheet
ActiveWindow.DisplayGridlines = False 'Remove Grid Lines in newly created sheet
'Adding Headers from Data sheet to newly created worksheet
SH.Range("A1:C1").Copy NewSh.Range("A1")
'Internal Loop for Years
NewRow = 2: ColumnNumber = 6
'NewRow denotes about the row that i need to add the data
'Column Numbers denotes about ---- starting column number for Years
For Y = 0 To UserForm1.ListBox3.ListCount - 1 'Internal Loop for Years Selection
If UserForm1.ListBox3.Selected(Y) = True Then ' If it hits the selection
r = 2 'Do Loop Variable
SH.Activate 'activating Dataworksheet
StartRow = NewRow ' Startrow using as variable in range while calculating the function in NewWorksheet
Do Until SH.Range("A" & r).Value = "" ' Iterating all the rows in data worksheet
If Val(Year(SH.Range("A" & r))) = UserForm1.ListBox3.List(Y, 0) And _
SH.Range("B" & r).Value = UserForm1.ListBox1.List(ItemsLoop, 0) Then
' if Year from Listbox3 and Item from listbox1 matched with Column A & B respectively the add the rows
NewSh.Range("A" & NewRow).Value = SH.Range("A" & r).Value
NewSh.Range("B" & NewRow).Value = SH.Range("B" & r).Value
NewSh.Range("C" & NewRow).Value = SH.Range("C" & r).Value
NewRow = NewRow + 1 'increasing newrow variable value by 1 when data matched
End If ' Close Years IF condition
r = r + 1 ' Increasing the Loop Variable
Loop ' End of the Do Loop
NewSh.Activate 'Activating Newly created worksheet
NewSh.Cells(2, ColumnNumber).Value = UserForm1.ListBox3.List(Y, 0) 'Adding the Year in newworksheet
'Retrieve the result by using the function which is selected in Listbox2
NewSh.Cells(3, ColumnNumber).Value = RetrieveFunctionResult(FunctionName, StartRow, NewRow)
ColumnNumber = ColumnNumber + 1 ' Increasing the columnnumber which is useful to add the Years
End If ' end of Years IF condition
Next 'End of Years Loop
NewSh.Range("E2").Value = "Years" 'Adding the Year
NewSh.Range("E3").Value = FunctionName ' Adding the function name
CreateChart (ColumnNumber) ' Create Chart Function ...ColumnNumber is useful to define the max column of Chart Data
'Resize the column width based on text length
NewSh.Range("A1").CurrentRegion.Columns.AutoFit
End If 'End of If condition ----- used for Item selection
Next 'End of Items Loop
Unload UserForm1
MsgBox "Hi Pavan Chart Created"
End Sub
'Define the Data Worksheet
Function DefineWorksheet()
Set SH = ThisWorkbook.Sheets("Data")
End Function
'Define the LastRow
Function DefineLastRow()
DefineLastRow = SH.Range("A" & Rows.Count).End(xlUp).Row
End Function
Function RetrieveFunctionResult(FunctionName, StartRow, NewRow)
If FunctionName = "Count" Then
Result = Application.WorksheetFunction.Count(Range(Cells(StartRow, 3), Cells(NewRow - 1, 3)))
ElseIf FunctionName = "Sum" Then
Result = Application.WorksheetFunction.Sum(Range(Cells(StartRow, 3), Cells(NewRow - 1, 3)))
ElseIf FunctionName = "Average" Then
Result = Application.WorksheetFunction.Average(Range(Cells(StartRow, 3), Cells(NewRow - 1, 3)))
ElseIf FunctionName = "Mean" Then
Result = Application.WorksheetFunction.Median(Range(Cells(StartRow, 3), Cells(NewRow - 1, 3)))
ElseIf FunctionName = "Max" Then
Result = Application.WorksheetFunction.Max(Range(Cells(StartRow, 3), Cells(NewRow - 1, 3)))
ElseIf FunctionName = "Min" Then
Result = Application.WorksheetFunction.Min(Range(Cells(StartRow, 3), Cells(NewRow - 1, 3)))
End If
RetrieveFunctionResult = Result
End Function
Function AddNewWorksheet()
Set NewSh = ThisWorkbook.Sheets.Add(after:=Sheets("Data"))
End Function
Function DeleteWorksheets()
For Each S In ThisWorkbook.Worksheets
If S.Name <> "Introduction" And S.Name <> "Data" Then
S.Delete
End If
Next
End Function
Function CreateChart(ColumnNumber)
Dim ch As ChartObject
With NewSh.Range("F5:M21")
Set ch = NewSh.ChartObjects.Add( _
Left:=.Left, _
Height:=.Height, _
Width:=.Width, _
Top:=.Top)
End With
With ch.Chart
.ChartType = xlLine
.SeriesCollection.NewSeries
.SeriesCollection(1).Name = NewSh.Range("E3").Value & " Of Items"
.SeriesCollection(1).Values = NewSh.Range(Cells(3, 6), Cells(3, ColumnNumber - 1))
.SeriesCollection(1).XValues = NewSh.Range(Cells(2, 6), Cells(2, ColumnNumber - 1))
.SeriesCollection(1).ApplyDataLabels
.HasLegend = False
End With
End Function
Large Data Analysis
Excel - VBA - SQL --- Report Generation
Retrieve Mail IDs