I have a VBA code that is working just for the first 3 graphs.
I am trying to create other graphs using VBA in the main sheet. First of all, I have a dashboard and I would like to have a main sheet that summarize some name that I want to search for, so all my data are in other sheets. Also I would like to create more than one graph in the main sheet.
I created a VBA IF condition that search for a specific name, which the names that are in the data sheet are like this:
With that in mind, I dim an "i" to find the name that I want in the data sheet. When someone wants to search for name1 or name 2..., the person will choose the name in main sheet, which the cell is: "C3". If C3 cell in main sheet is equal to the data sheet B2 or Q2... then create a graph.
So the code that works for the first 3 graphs is:
Private Sub worksheet_change(ByVal target As Range)
Dim cht As Chart, cht2 As Chart, cht3 As Chart, co As Object, co2 As Object, co3 As Object
Dim i As Long
Dim LastRow As Long, rngX As Range, rngY As Range, rngX2 As Range, rngY2 As Range, rngX3 As Range, rngY3 As Range
Dim LastColumn As Long, wsMain As Worksheet, wsData As Worksheet
Set wsData = ThisWorkbook.Worksheets("Data")
Set wsMain = ThisWorkbook.Worksheets("Main")
If target = wsMain.Cells(3, 3) Then
For i = 2 To 500 Step 15 'loop in increments of 15
If wsData.Cells(2, i) = wsData.Cells(4, 3) Then
'define data ranges
Set rngX = wsData.Range(wsData.Cells(6, i), wsData.Cells(Rows.Count, i).End(xlUp))
Set rngY = rngX.Offset(0, 1)
Set rngX2 = rngX
Set rngY2 = rngX2.Offset(0, 2)
Set rngX3 = rngX
Set rngY3 = rngX3.Offset(0, 3)
ClearWorksheetCharts wsMain 'remove any existing chart(s)
With wsMain.Range("B22:H37")
'add chartobject, setting position and size
Set co = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
With wsMain.Range("B39:H54")
'add chartobject, setting position and size
Set co2 = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
With wsMain.Range("B56:H71")
'add chartobject, setting position and size
Set co3 = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
Set cht = co.Chart
ClearChartSeries cht 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht, "25%", rngX, rngY
AddSeries cht, "50%", rngX, rngY.Offset(0, 5)
AddSeries cht, "25%", rngX, rngY.Offset(0, 10)
cht.Axes(xlCategory).ReversePlotOrder = True
cht.HasTitle = True
cht.ChartTitle.Text = "1 month"
Set cht2 = co2.Chart
ClearChartSeries cht2 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht2, "25% ", rngX2, rngY2
AddSeries cht2, "50%", rngX2, rngY2.Offset(0, 5)
AddSeries cht2, "25%", rngX2, rngY2.Offset(0, 10)
cht2.Axes(xlCategory).ReversePlotOrder = True
cht2.HasTitle = True
cht2.ChartTitle.Text = "2 months"
Set cht3 = co3.Chart
ClearChartSeries cht3 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht3, "25%", rngX3, rngY3
AddSeries cht3, "50%", rngX3, rngY3.Offset(0, 5)
AddSeries cht3, "25%", rngX3, rngY3.Offset(0, 10)
cht3.Axes(xlCategory).ReversePlotOrder = True
cht3.HasTitle = True
cht3.ChartTitle.Text = "3 months"
End If
Next i
End If
End Sub
'add a series and name it (factored out from main sub)
Sub AddSeries(cht As Chart, serName As String, serX, serY)
With cht.SeriesCollection.NewSeries
.Name = serName
.XValues = serX
.Values = serY
End With
End Sub
'remove any existing series from a chart
Sub ClearChartSeries(cht As Chart)
Do While cht.SeriesCollection.Count > 0
cht.SeriesCollection(1).Delete
Loop
End Sub
'Remove any chart objects from `ws`
Sub ClearWorksheetCharts(ws As Worksheet)
Do While ws.ChartObjects.Count > 0
ws.ChartObjects(1).Delete
Loop
End Sub
Then I tried to add other 3 different graphs in the same SUB:
Private Sub worksheet_change(ByVal target As Range)
Dim cht As Chart, cht2 As Chart, cht3 As Chart, co As Object, co2 As Object, co3 As Object
Dim cht4 As Chart, cht5 As Chart, cht6 As Chart, co4 As Object, co5 As Object, co6 As Object
Dim i As Long
Dim LastRow As Long, rngX As Range, rngY As Range, rngX2 As Range, rngY2 As Range, rngX3 As Range, rngY3 As Range
Dim rngX4 As Range, rngY4 As Range, rngX5 As Range, rngY5 As Range, rngX6 As Range, rngY6 As Range
Dim LastColumn As Long, wsMain As Worksheet, wsData As Worksheet, wsData2 As Worksheet
Set wsData = ThisWorkbook.Worksheets("Data")
Set wsData2 = ThisWorkbook.Worksheets("Data2")
Set wsMain = ThisWorkbook.Worksheets("Main")
If target = wsMain.Cells(3, 3) Then
ClearWorksheetCharts wsMain 'remove any existing chart(s)
For i = 2 To 500 Step 15 'loop in increments of 15
If wsData.Cells(2, i) = wsMain.Cells(4, 3) Then
'define data ranges
Set rngX = wsData.Range(wsData.Cells(6, i), wsData.Cells(Rows.Count, i).End(xlUp))
Set rngY = rngX.Offset(0, 1)
Set rngX2 = rngX
Set rngY2 = rngX2.Offset(0, 2)
Set rngX3 = rngX
Set rngY3 = rngX3.Offset(0, 3)
With wsMain.Range("B22:H37")
'add chartobject, setting position and size
Set co = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
With wsMain.Range("B39:H54")
'add chartobject, setting position and size
Set co2 = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
With wsMain.Range("B56:H71")
'add chartobject, setting position and size
Set co3 = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
Set cht = co.Chart
ClearChartSeries cht 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht, "25%", rngX, rngY
AddSeries cht, "50%", rngX, rngY.Offset(0, 5)
AddSeries cht, "25%", rngX, rngY.Offset(0, 10)
cht.Axes(xlCategory).ReversePlotOrder = True
cht.HasTitle = True
cht.ChartTitle.Text = "1 month"
Set cht2 = co2.Chart
ClearChartSeries cht2 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht2, "25% ", rngX2, rngY2
AddSeries cht2, "50%", rngX2, rngY2.Offset(0, 5)
AddSeries cht2, "25%", rngX2, rngY2.Offset(0, 10)
cht2.Axes(xlCategory).ReversePlotOrder = True
cht2.HasTitle = True
cht2.ChartTitle.Text = "2 months"
Set cht3 = co3.Chart
ClearChartSeries cht3 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht3, "25%", rngX3, rngY3
AddSeries cht3, "50%", rngX3, rngY3.Offset(0, 5)
AddSeries cht3, "25%", rngX3, rngY3.Offset(0, 10)
cht3.Axes(xlCategory).ReversePlotOrder = True
cht3.HasTitle = True
cht3.ChartTitle.Text = "3 months"
End If
Next i
For i = 2 To 500 Step 15 'loop in increments of 15
If wsData2.Cells(3, i) = wsMain.Cells(3, 3) Then
'define data ranges
Set rngX4 = wsData2.Range(wsData2.Cells(6, i), wsData2.Cells(Rows.Count, i).End(xlUp))
Set rngY4 = rngX4.Offset(0, 1)
Set rngX5 = rngX4
Set rngY5 = rngX5.Offset(0, 2)
Set rngX6 = rngX4
Set rngY6 = rngX6.Offset(0, 3)
With wsMain.Range("J22:P37")
'add chartobject, setting position and size
Set co4 = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
With wsMain.Range("J39:P54")
'add chartobject, setting position and size
Set co5 = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
With wsMain.Range("J56:P71")
'add chartobject, setting position and size
Set co6 = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
Set cht4 = co4.Chart
ClearChartSeries cht4 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht4, "25%", rngX4, rngY4
AddSeries cht4, "50%", rngX4, rngY4.Offset(0, 5)
AddSeries cht4, "25%", rngX4, rngY4.Offset(0, 10)
cht4.Axes(xlCategory).ReversePlotOrder = True
cht4.HasTitle = True
cht4.ChartTitle.Text = "1 month"
Set cht5 = co5.Chart
ClearChartSeries cht5 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht5, "25%", rngX5, rngY5
AddSeries cht5, "50%", rngX5, rngY5.Offset(0, 5)
AddSeries cht5, "25%", rngX5, rngY5.Offset(0, 10)
cht5.Axes(xlCategory).ReversePlotOrder = True
cht5.HasTitle = True
cht5.ChartTitle.Text = "2 months"
Set cht6 = co6.Chart
ClearChartSeries cht6 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht6, "25%", rngX6, rngY6
AddSeries cht6, "50%", rngX6, rngY6.Offset(0, 5)
AddSeries cht6, "25%", rngX6, rngY6.Offset(0, 10)
cht6.Axes(xlCategory).ReversePlotOrder = True
cht6.HasTitle = True
cht6.ChartTitle.Text = "3 months"
End If
Next i
End If
End Sub
'add a series and name it (factored out from main sub)
Sub AddSeries(cht As Chart, serName As String, serX, serY)
With cht.SeriesCollection.NewSeries
.Name = serName
.XValues = serX
.Values = serY
End With
End Sub
'remove any existing series from a chart
Sub ClearChartSeries(cht As Chart)
Do While cht.SeriesCollection.Count > 0
cht.SeriesCollection(1).Delete
Loop
End Sub
'Remove any chart objects from `ws`
Sub ClearWorksheetCharts(ws As Worksheet)
Do While ws.ChartObjects.Count > 0
ws.ChartObjects(1).Delete
Loop
End Sub
But the code just works for some graphs like this:
What am I doing wrong? Why just some graphs work? Thank you!!!
CodePudding user response:
Keep on factoring out your common code and you'll see it's easier to troubleshoot. Untested, but try this:
Private Sub worksheet_change(ByVal target As Range)
Dim cht As Chart
Dim i As Long
Dim LastRow As Long, rngX As Range
Dim wsMain As Worksheet, wsData As Worksheet, wsData2 As Worksheet
Set wsData = ThisWorkbook.Worksheets("Data")
Set wsData2 = ThisWorkbook.Worksheets("Data2")
Set wsMain = ThisWorkbook.Worksheets("Main")
If target.Address <> wsMain.Cells(3, 3).Address Then Exit Sub 'not monitoring this cell
ClearWorksheetCharts wsMain 'remove any existing chart(s)
For i = 2 To 500 Step 15 'loop in increments of 15
If wsData.Cells(2, i) = wsData.Cells(4, 3) Then
Set rngX = wsData.Range(wsData.Cells(6, i), wsData.Cells(Rows.Count, i).End(xlUp))
Set cht = NewChart(wsMain.Range("B22:H37"), "1 month")
AddThreeSeries cht, rngX, rngX.Offset(0, 1)
Set cht = NewChart(wsMain.Range("B39:H54"), "2 months")
AddThreeSeries cht, rngX, rngX.Offset(0, 2)
Set cht = NewChart(wsMain.Range("B56:H71"), "3 months")
AddThreeSeries cht, rngX, rngX.Offset(0, 3)
End If
Next i
For i = 2 To 500 Step 15 'loop in increments of 15
If wsData2.Cells(2, i) = wsData.Cells(4, 3) Then
Set rngX = wsData2.Range(wsData.Cells(6, i), wsData2.Cells(Rows.Count, i).End(xlUp))
Set cht = NewChart(wsMain.Range("J22:P37"), "1 month")
AddThreeSeries cht, rngX, rngX.Offset(0, 1)
Set cht = NewChart(wsMain.Range("J39:P54"), "2 months")
AddThreeSeries cht, rngX, rngX.Offset(0, 2)
Set cht = NewChart(wsMain.Range("J56:P71"), "3 months")
AddThreeSeries cht, rngX, rngX.Offset(0, 3)
End If
Next i
End Sub
'add a new chart, and perform some common setup steps
Function NewChart(rng As Range, title As String) As Chart
Dim cht As Chart, co As Object
With rng
Set co = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
Set cht = co.Chart
ClearChartSeries cht
cht.Axes(xlCategory).ReversePlotOrder = True
cht.HasTitle = True
cht.ChartTitle.Text = title
Set NewChart = cht 'return the chart we just created
End Function
'wrap up common steps in a separate method
Sub AddThreeSeries(cht As Chart, rngX As Range, rngY As Range)
AddSeries cht, "25%", rngX, rngY
AddSeries cht, "50%", rngX, rngY.Offset(0, 5)
AddSeries cht, "25%", rngX, rngY.Offset(0, 10)
End Sub
'add a series and name it (factored out from main sub)
Sub AddSeries(cht As Chart, serName As String, serX, serY)
With cht.SeriesCollection.NewSeries
.Name = serName
.XValues = serX
.Values = serY
End With
End Sub
'remove any existing series from a chart
Sub ClearChartSeries(cht As Chart)
Do While cht.SeriesCollection.Count > 0
cht.SeriesCollection(1).Delete
Loop
End Sub
'Remove any chart objects from `ws`
Sub ClearWorksheetCharts(ws As Worksheet)
Do While ws.ChartObjects.Count > 0
ws.ChartObjects(1).Delete
Loop
End Sub