Delete chart series but keep their formatting

Question

This is the code I use to dynamically create charts in Virtual Basic:

Dim Chart As Object
Set Chart = Charts.Add
With Chart
    If bIssetSourceChart Then
        CopySourceChart
        .Paste Type:=xlFormats
    End If
    For Each s In .SeriesCollection
        s.Delete
    Next s
    .ChartType = xlColumnClustered
    .Location Where:=xlLocationAsNewSheet, Name:=chartTitle
    Sheets(chartTitle).Move After:=Sheets(Sheets.count)
    With .SeriesCollection.NewSeries
        If Val(Application.Version) >= 12 Then
            .values = values
            .XValues = columns
            .Name = chartTitle
        Else
            .Select
            Names.Add "_", columns
            ExecuteExcel4Macro "series.columns(!_)"
            Names.Add "_", values
            ExecuteExcel4Macro "series.values(,!_)"
            Names("_").Delete
        End If
    End With
End With

#The CopySourceChart Sub:
Sub CopySourceChart()
    If Not CheckSheet("Source chart") Then
        Exit Sub
    ElseIf TypeName(Sheets("Grafiek")) = "Chart" Then
        Sheets("Grafiek").ChartArea.Copy
    Else
        Dim Chart As ChartObject

        For Each Chart In Sheets("Grafiek").ChartObjects
            Chart.Chart.ChartArea.Copy
            Exit Sub
        Next Chart
    End If
End Sub

How can I keep the formatting of series that is applied in the If bIssetSourceChart part while deleting those series' data?

Answer 1

I have solved this issue before. I have charts that were created by macro but it only applied to the date I made them. So a made a refresh macro that runs after every Workbook open. I used source before and found that it deletes everything. then moved on to series only. I will paste my work here and try to explain. For quick navigation the second part of the code down there called sub aktualizacegrafu() might help you if you get lost find a reference in upper part of the code starting with sub generacegrafu()

Sub generacegrafu()
ThisWorkbook.Sheets("List1").CommandButton6.BackColor = &H0&
ThisWorkbook.Sheets("List1").CommandButton6.ForeColor = &HFFFFFF
Dim najdiposlradek As Object
Dim graf As Object
Dim vkladacistring As String
Dim vykreslenysloupec As Integer
Dim hledejsloupec As Object
Dim hledejsloupec2 As Object
Dim kvantifikator As Integer
Dim grafx As ChartObject
Dim shoda As Boolean
Dim jmenografu As String
Dim rngOrigSelection As Range


Cells(1, 1).Select
If refreshcharts = True Then
    Set hledejsloupec = Range("11:11").Find(What:=prvnislovo, LookIn:=xlValues) 
'dynamicaly generated, prvnislovo is for first word in graph and the macro looks for match in row 11 if it doesnt find any then
Else
'then it looks for match in option box
    Set hledejsloupec = Range("11:11").Find(What:=ThisWorkbook.Sheets("List1").ComboBox1.Value, LookIn:=xlValues) 
End If
If hledejsloupec Is Nothing Then
    MsgBox "Zadaný sloupec v první nabídce nebyl nalezen."
Else
    If refreshcharts = True Then
        Set hledejsloupec2 = Range("11:11").Find(What:=druheslovo, LookIn:=xlValues)
    Else
        Set hledejsloupec2 = Range("11:11").Find(What:=ThisWorkbook.Sheets("List1").ComboBox2.Value, LookIn:=xlValues)
    End If
    If hledejsloupec2 Is Nothing Then
        MsgBox "Zadaný sloupec v druhé nabídce nebyl nalezen."
    Else
        jmenografu = Cells(11, hledejsloupec.Column).Value & "_" & Cells(11, hledejsloupec2.Column).Value
        Set najdiposlradek = Range("A:A").Find(What:=Date, LookIn:=xlValues)

        Application.ScreenUpdating = False
        Set rngOrigSelection = Selection
       'This one selects series for new graph to be created
        Cells(1048576, 16384).Select
        Set graf = ThisWorkbook.Sheets("List1").Shapes.AddChart
        rngOrigSelection.Parent.Parent.Activate
        rngOrigSelection.Parent.Select
        rngOrigSelection.Select 'trouble with annoing excel feature to unselect graphs

        Application.ScreenUpdating = True

        graf.Select
        kvantifikator = 1
        Do
            shoda = False
            For Each grafx In ThisWorkbook.Sheets("List1").ChartObjects
                If grafx.Name = jmenografu Then
                    shoda = True
                    jmenografu = jmenografu & "(" & kvantifikator & ")"
                    kvantifikator = kvantifikator + 1
                End If
            Next grafx
    'this checks if graph has younger brother in sheet
'but no we get to the part that matter do not bother playing with source of the graph because I have found it is quite hard to make it work properly
        Loop Until shoda = False
'here it starts
        ActiveChart.Parent.Name = jmenografu
        ActiveChart.SeriesCollection.NewSeries 'add only series!
        vkladacistring = "=List1!R12C" & hledejsloupec.Column & ":R" & najdiposlradek.Row & "C" & hledejsloupec.Column 'insert this into series
        ActiveChart.SeriesCollection(1).Values = vkladacistring
        vkladacistring = "=List1!R11C" & hledejsloupec.Column
        ActiveChart.SeriesCollection(1).Name = vkladacistring
        vkladacistring = "=List1!R12C" & hledejsloupec2.Column & ":R" & najdiposlradek.Row & "C" & hledejsloupec2.Column
        ActiveChart.SeriesCollection(1).XValues = vkladacistring
'here it ends and onward comes formating
        ActiveChart.Legend.Delete
        ActiveChart.ChartType = xlConeColClustered
        ActiveChart.ClearToMatchStyle
        ActiveChart.ChartStyle = 41
        ActiveChart.ClearToMatchStyle
        ActiveSheet.Shapes(jmenografu).Chart.ChartArea.Format.ThreeD.RotationY = 90
        ActiveSheet.Shapes(jmenografu).Chart.ChartArea.Format.ThreeD.RotationX = 0
        ActiveChart.Axes(xlValue).MajorUnit = 8.33333333333333E-02
        ActiveChart.Axes(xlValue).MinimumScale = 0.25
        ActiveChart.Walls.Format.Fill.Visible = msoFalse
        ActiveChart.Axes(xlCategory).MajorUnitScale = xlMonths
        ActiveChart.Axes(xlCategory).MajorUnit = 1
        ActiveChart.Axes(xlCategory).BaseUnit = xlDays
    End If
End If
Call aktualizacelistboxu
ThisWorkbook.Sheets("List1").CommandButton6.BackColor = &H8000000D
ThisWorkbook.Sheets("List1").CommandButton6.ForeColor = &H0&
End Sub

the result i found is that you cannot keep formating completely when you close chart because source of chart doesnt work very well and when you delete it some format will be lost I will post my actualization of chart as well

Sub aktualizacegrafu()
Dim grafx As ChartObject
Dim hledejsloupec As Object
Dim hledejsloupec2 As Object
Dim vkladacistring As String
Dim najdiposlradek As Object

For Each grafx In ThisWorkbook.Sheets("List1").ChartObjects
    prvnislovo = Left(grafx.Name, InStr(1, grafx.Name, "_") - 1)
    druheslovo = Right(grafx.Name, Len(grafx.Name) - InStr(1, grafx.Name, "_")) 
'now it checks the names of charts .. the data loads from respective columns that are named the same way so I ussualy choose what statistic I want by choosing the columns needed
'for example I want to reflect my arrivals to work according to the hours I worked or to the date so I set 1st option to arrival and 2nd to date
grafx.Activate
Set najdiposlradek = Range("A:A").Find(What:=Date, LookIn:=xlValues)
Set hledejsloupec = Range("11:11").Find(What:=prvnislovo, LookIn:=xlValues)
If hledejsloupec Is Nothing Then
    MsgBox "Hodnota v grafu již není mezi sloupci v tabulce. Aktualizace grafu " & grafx.Name & " bude ukončena."
Else
    Set hledejsloupec2 = Range("11:11").Find(What:=druheslovo, LookIn:=xlValues)
    If hledejsloupec2 Is Nothing Then
        MsgBox "Hodnota v grafu již není mezi sloupci v tabulce. Aktualizace grafu " & grafx.Name & " bude ukončena."
    Else

here it enters string that contains adress of desired cell I always enter it as string cause its easier to see with debug.print what is being entered

result looks like this List means Sheet in czech activechart.seriescollection(1).values=List1!R12C1:R13C16 activechart.seriescollection(1).name=List1!R1C1:R1C15

        vkladacistring = "=List1!R12C" & hledejsloupec.Column & ":R" & najdiposlradek.Row & "C" & hledejsloupec.Column
        ActiveChart.SeriesCollection(1).Values = vkladacistring
        vkladacistring = "=List1!R11C" & hledejsloupec.Column
        ActiveChart.SeriesCollection(1).Name = vkladacistring
        vkladacistring = "=List1!R12C" & hledejsloupec2.Column & ":R" & najdiposlradek.Row & "C" & hledejsloupec2.Column
        ActiveChart.SeriesCollection(1).XValues = vkladacistring
    End If
End If
Next grafx
Call aktualizacelistboxu
End Sub

so result of this is when you actually have a chart already but want to make slight changes to the area it applies to then it keeps the formating hope this helped a bit if not I am sorry if it did keep the revard. It just got me curious because I was solving the same problem recently if you need any further explanation comment this and I will try to explain