Sunday, February 9, 2014

Generate Chart on Worksheet_Change Event

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$E$2" Then
        Select Case Target.Value
            Case "SOUTH"
                Call createGraph(Target.Value)
     
            Case "WEST"
                Call createGraph(Target.Value)
            Case "NORTH"
                Call createGraph(Target.Value)
            Case "MIDWEST"
                Call createGraph(Target.Value)
         
        End Select
    End If
End Sub


Dim myChart As Chart, rowcount As Long, datarng As Range, axisrng As Range
Public Sub createGraph(mycriteria As String)
'On Error Resume Next
Application.ScreenUpdating = False
    ThisWorkbook.Sheets("Dashboard").Range(ThisWorkbook.Sheets("Dashboard").Range("D6").CurrentRegion.Address).Clear
    ThisWorkbook.Sheets(2).Range("A1").AutoFilter Field:=1, Criteria1:=mycriteria
    ThisWorkbook.Sheets(2).UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=ThisWorkbook.Sheets(1).Range("D6")
    ThisWorkbook.Sheets(1).ChartObjects.Delete
    rowcount = ThisWorkbook.Sheets(1).Range("D6").End(xlDown).Row
    Set datarng = ThisWorkbook.Sheets(1).Range("J7:J" & rowcount)
    Set axisrng = ThisWorkbook.Sheets(1).Range("D7:D" & rowcount)

    Set myChart = Charts.Add
    Set myChart = myChart.Location(xlLocationAsObject, "Dashboard")
 
        With myChart
            .Parent.Top = ThisWorkbook.Sheets(1).Range("D6").Top
            .Parent.Left = ThisWorkbook.Sheets(1).Range("D10").Left
            .Parent.Width = ThisWorkbook.Sheets(1).Range("D10:J10").Width
            .Parent.Height = ThisWorkbook.Sheets(1).Range("D6:D20").Height
            .SetSourceData Source:=datarng
            .SeriesCollection(1).XValues = axisrng
            .HasTitle = True
            .ChartType = xlColumnClustered
            .SetElement (msoElementChartTitleAboveChart)
            .ChartTitle.Caption = "Sales amount for " & mycriteria
        End With
    End Sub


https://drive.google.com/file/d/0B23eJ2xd9ODyZ2V1LUdYNXVmMFE/edit?usp=sharing

No comments:

Post a Comment