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
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