Multiple charts by groups in column VBA-CodePudding

m completely new to vba programming and I was unable to find similar questions. Please guide me in the right direction if the answer to a similar problem is already to be found in this forum.

I have the following dataset (in practice, the dataset contains more names and dates per name):

Name    Date    Value1  Value2
AA  01-02-2022  0.5744  10
AA  01-03-2022  0.5542  10
AA  01-04-2022  0.5551  10
AA  01-05-2022  0.5678  10
BB  01-02-2022  0.5518  11
BB  01-03-2022  0.5659  11
BB  01-04-2022  0.5455  11
BB  01-05-2022  0.5404  11
CC  01-02-2022  0.5524  12
CC  01-03-2022  0.5321  12
CC  01-04-2022  0.5554  12
CC  01-05-2022  0.5407  12

I want to create multiple charts using VBA - separate charts for each name in column "Name" i.e. one chart for AA, another chart for BB and a third chart for CC etc.VBA The charts should plot Value1 and Value2 on the Y-axis against Date on the X-axis.

The data is loaded into the spreadsheet using a power query, which extracts data from an Oracle database.

If possible, I would like to place the charts next and/or appended to each other.

As (new) names are regularly removed (added) to the dataset, I am looking for a dynamic solution and hope to solve this using VBA.

Please do not hesitate to comment if I need be more clear in my description or to elaborate.

Kind regards,

CodePudding user response：

Please, try the next code. It uses a dictionary to keep the unique names as key and range first row, respectively, last row as items. Then builds DataSource based on them:

Sub TestInsertCClusteredChart()
  Dim sh As Worksheet, lastR As Long, arr, arrIt, i As Long, dict As Object
  Dim rngDS As Range, ch_shape As Shape, chLeft As Double, chTop As Double
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  
  arr = sh.Range("A1:A" & lastR).Value2
  
  Set dict = CreateObject("Scripting.Dictionary")
  'dict.RemoveAll
  For i = 2 To UBound(arr)
        If Not dict.Exists(arr(i, 1)) Then
                dict.Add arr(i, 1), Array(i)
        Else
                arrIt = dict(arr(i, 1))
                If UBound(arrIt) = 0 Then
                    ReDim Preserve arrIt(1)
                    arrIt(1) = i
                Else
                    arrIt(1) = i
                End If
                dict(arr(i, 1)) = arrIt
        End If
  Next i
  
  chLeft = sh.Range("F2").left: chTop = sh.Range("F2").top 'positions of the first chart
  'build dataSource range and insert chart:
  For i = 0 To dict.count - 1
      Set rngDS = Union(sh.Range("A1:D1"), sh.Range(sh.cells(dict.Items()(i)(0), "A"), sh.cells(dict.Items()(i)(1), "D")))
      Set ch_shape = sh.Shapes.AddChart2  'insert the chart
      With ch_shape.Chart
        With .ChartArea
            .left = chLeft
            .top = chTop
        End With
        .ChartType = xlColumnClustered
        .SetSourceData rngDS
         chLeft = chLeft   .ChartArea.width 'calculate the left position for the next chart
    End With
  Next i
End SubSub TestInsertCClusteredChart()
  Dim sh As Worksheet, lastR As Long, arr, arrIt, i As Long, dict As Object
  Dim rngDS As Range, ch_shape As Shape, chLeft As Double, chTop As Double, k As Long
  Const chNo As Long = 3
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  
  arr = sh.Range("A1:A" & lastR).Value2
  
  Set dict = CreateObject("Scripting.Dictionary")
  
  For i = 2 To UBound(arr)
        If Not dict.Exists(arr(i, 1)) Then
                dict.Add arr(i, 1), Array(i)
        Else
                arrIt = dict(arr(i, 1))
                If UBound(arrIt) = 0 Then
                    ReDim Preserve arrIt(1)
                    arrIt(1) = i
                Else
                    arrIt(1) = i
                End If
                dict(arr(i, 1)) = arrIt
        End If
  Next i
  deleteCharts sh   'delete existing charts, if any
  
  chLeft = sh.Range("F2").left: chTop = sh.Range("F2").top 'positions of the first chart
  'build dataSource range and insert chart:
  For i = 0 To dict.count - 1
      Set rngDS = Union(sh.Range("B1:D1"), sh.Range(sh.cells(dict.Items()(i)(0), "B"), sh.cells(dict.Items()(i)(1), "D")))
      Set ch_shape = sh.Shapes.AddChart2  'insert the chart
      k = k   1
      With ch_shape.Chart
        With .ChartArea
            .left = chLeft
            .top = chTop
        End With
        .HasTitle = True
        .chartTitle.Text = dict.Keys()(i)
        .ChartType = xlColumnClustered
        .SetSourceData rngDS
         chLeft = chLeft   .ChartArea.width   2 'calculate the left position for the next chart
         
         'adapt variables to be placed on the next row:
         If k = chNo Then chLeft = sh.Range("F2").left: chTop = chTop   .ChartArea.height   2: k = 0
    End With
  Next i
End Sub

Sub deleteCharts(sh As Worksheet)
   Dim s As Shape
   For Each s In sh.Shapes
        If s.HasChart Then s.Delete
   Next
End Sub

Please, send some feedback after testing it.

The chart is created using default dimensions (height, width). They can be set, of course.

Adapted the code according to your recent requirements.