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


     

    Download The Workbook

     

     

    Large Data Analysis

     

  • Prepare stat based on region wise and item wise
  •  

    Download The Workbook

     

    Excel - VBA - SQL --- Report Generation

     

     

    Download The Workbook

     

     

    Retrieve Mail IDs

     

  • Retrieve any mail id list from the available data
  •