Chart series source not updating

[Jon von der Heyden]

Hi,

I have a series of charts in a worksheet within a workbook. The source data to these are in the same workbook but different worksheets.

I then have a macro that groups all worksheets and then moves a copy to a new workbook.

The problem I'm encountering is that the chart source in the new workbook continues to reference the original workbook, yet the other formulae don't and continue to function properly.

Is there anyway of preventing this?

Cheers,
Jon

 

[Jon von der Heyden]

bump

 

[NdNoviceHlp]

Depends if you want to have active chart data in the new wb. If not run this code before grouping and copying the ws's. Dave

Sub DisconnectChartData()
'(Jon Peltier's code to disconnect chart from data)
Dim nPts As Long, iPts As Long
    Dim xArray As String, yArray As String
    Dim xVals, yVals
    Dim ChtSeries As Series
    Dim iChars As Integer
    Dim sChtName As String
    Dim sSrsName As String
    Dim iPlotOrder As Integer

For Each ChtSeries In Co.Chart.SeriesCollection
        nPts = ChtSeries.Points.Count
        xArray = ""
        yArray = ""
        xVals = ChtSeries.XValues
        yVals = ChtSeries.Values
        sSrsName = ChtSeries.Name
        iPlotOrder = ChtSeries.PlotOrder

        For iPts = 1 To nPts
            If IsNumeric(xVals(iPts)) Then
                ''' shorten numbers in X array (remove excess digits)
                iChars = WorksheetFunction.Max _
                    (InStr(CStr(xVals(iPts)), "."), 5)
                xArray = xArray & Left(CStr(xVals(iPts)), iChars) & ","
            Else
                ''' put quotes around string values
                xArray = xArray & """" & xVals(iPts) & ""","
            End If

            ''' shorten numbers in Y array (remove excess digits)
            iChars = WorksheetFunction.Max _
                (InStr(CStr(yVals(iPts)), "."), 5)

           ''' handle missing data - replace blanks and #N/A with #N/A
           If IsEmpty(yVals(iPts)) Or WorksheetFunction.IsNA(yVals(iPts)) Then
               yArray = yArray & "#N/A,"
           Else
               yArray = yArray & Left(CStr(yVals(iPts)), iChars) & ","
           End If

        Next

        ''' remove final comma
        xArray = Left(xArray, Len(xArray) - 1)
        yArray = Left(yArray, Len(yArray) - 1)

        ''' Construct the new series formula
        ChtSeries.Formula = "=SERIES(""" & sSrsName & """,{" & xArray & "},{" _
            & yArray & "}," & CStr(iPlotOrder) & ")"
    Next
End Sub

edit: should have mentioned this will leave your charts in the original wb permanently inactive. If this isn't OK you may want to copy the wb and then disconnect, group etc from the copied file

 

[Jon von der Heyden]

Hi,

Unfortunately I need to keep it active, but thanks for the code because I've found another instance where I could use this.

Anybody else have any other ideas? This is the code I'm using to create the various templates - it's within these templates that the chart formula continue to reference the master template:

Sub RunSim()

Dim LastRow As Long, rng1 As Range, rng2 As Range

With Application
    '.ScreenUpdating = False
    .Calculation = xlCalculationManual
End With


'Runs through a unique list of Business Areas and creates a new file for each
'-------------------------'-----------------------------------------------------------
For Each a In Range("Ba") 'change "Ba" to "Cc" for templates by cost centre & business area'

    '-------------------------------------------------------------------------------'
    ' Update Workbooks("----").Activate after you make any changes to the file name '
    '-------------------------------------------------------------------------------'
    
    Workbooks("Master Template v0.1.xls").Activate
    
    Sheets(Array("Cover", "Charts", "Var", "Bs", "Bs Fcst", "Bs Plan", "Bs Bud", "P&L", "P&L Fcst", _
    "P&L Plan", "P&L Bud", "Act", "Bud", "Sim Tbl")).Copy
    
Sheets("BS").Range("B4").Value = a.Value
    
    
'Deletes actuals from the new file if the transaction doesn't correspond with the cost centre
'-------------------------------------------------------------------------------------

LastRow = WorksheetFunction.CountA(Sheets("Act").Range("A:A"))
    Set rng1 = Sheets("Act").Range("E2:E" & LastRow)
    Set rng2 = Sheets("Act").Range("E1:E" & LastRow)
    
        rng2.AutoFilter field:=5, Criteria1:="<>" & a.Value
            rng1.SpecialCells(xlCellTypeVisible).EntireRow.Delete
        

'Deletes budget from the new file if the transaction doesn't correspond with the cost centre
'-------------------------------------------------------------------------------------

LastRow = WorksheetFunction.CountA(Sheets("Bud").Range("A:A"))
    Set rng1 = Sheets("Bud").Range("E2:E" & LastRow)
    Set rng2 = Sheets("Bud").Range("E1:E" & LastRow)
    
        rng2.AutoFilter field:=5, Criteria1:="<>" & a.Value
            rng1.SpecialCells(xlCellTypeVisible).EntireRow.Delete


'Saves the file with a unique name
'---------------------------------------------------------------------------------------------

ActiveWorkbook.SaveAs Filename:="C:\Budget Template " & a & ".xls", FileFormat:=xlNormal, _
    Password:="", writerespassword:="", ReadOnlyRecommended:=False, CreateBackup:=False


'Recalculates all formula
'---------------------------------------------------------------------------------------------

Sheets("Cover").Select

Application.Calculation = xlCalculationAutomatic
Calculate
    

'Resaves the file and then closes it
'----------------------------------------------------------------------------------------------

With ActiveWorkbook
    .Save
    .Close
End With
        
Next a

MsgBox ("Done!")

'Application.ScreenUpdating = True

End Sub

 

[NdNoviceHlp]

Perhaps using copyfile instead of saveas may work? Dave

 

[Jon von der Heyden]

Thanks Dave,

I did that manually and it seemed to work, but I've just included update links in my macro to update the old links to the same file as the one created. Done that just this minutes and so far it's running ok...

Thanks for your suggestions.

Thanks,
Jon

 

[Jon Peltier]

I have a series of charts in a worksheet within a workbook. The source data to these are in the same workbook but different worksheets.

I then have a macro that groups all worksheets and then moves a copy to a new workbook.

The problem I'm encountering is that the chart source in the new workbook continues to reference the original workbook, yet the other formulae don't and continue to function properly.

Is there anyway of preventing this?

The trick is understanding how links work. Your charts link to sheets in the same workbook. When the sheets are copied elsewhere, the originals still exist, and the links still point to them, not to the copies. If the sheets instead are moved, there is no original copy in the original workbook, and the links point to the moved sheets.

The typical practice would be to save the workbook, move the sheets elsewhere, then copy them back into the original workbook.

This is backwards, though. I'm curious why you would keep the data in the same workbook, but link the charts to copies in another workbook.

 

[Jon von der Heyden]

Hi Jon, thanks for your reply.

In hind sight, knowing what I've learned from this, I would have built the macro differently.

I have a master template, one which contains all budget data for all of my business areas and cost centres. I need to issue a template for each business area and cost centre but that would take some effort, so the macro creates a new template for each based on the master and then goes through and deletes all other cost centre & business area data.

I ought to have used the Save As method, but I didn't because I didn't want to have to re-open the master template each time, that's why I kept the master template open and created a new template by moving a copy of each worksheet.

Because the macro uses a naming convention and saves the file to a specific location, it was possible to relink the series pointing at the original master template back to the new template.

ActiveWorkbook.ChangeLink Name:="P:\Budget 06-07\Master Template v0.1.xls", _
    newname:="C:\Budget Template " & a & ".xls", Type:=xlLinkTypeExcelLinks

Thanks eveybody for your help.

Jon