Home > Enterprise >  Replicate a VBA code (that works just to the first 3 graphs) to another 3 different graphs in the sa
Replicate a VBA code (that works just to the first 3 graphs) to another 3 different graphs in the sa

Time:07-22

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:

Data sheet

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:

Graphs

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