Return the Worksheet that an Excel Chart is referencing using VBA

Question

I need to be able to identify the worksheet that an excel chart (on a worksheet) is getting it's data from. I only need the data sheet which series 1 is referencing. I've started trying to extract the sheet name from .SeriesCollection(1).Formula but it gets realy complex. here's what I've got so far:

Sub GetChartDataSheet()

Dim DataSheetName As String
Dim DataSheet As Worksheet

DataSheetName = ActiveChart.SeriesCollection(1).Formula

DataSheetName = Left(DataSheetName, InStr(1, DataSheetName, "!$") - 1)
DataSheetName = WorksheetFunction.Replace(DataSheetName, 1, Len("=series("), "")
If Left(DataSheetName, 1) = "'" And Right(DataSheetName, 1) = "'" Then DataSheetName = Mid(DataSheetName, 2, Len(DataSheetName) - 2)
DataSheetName = Replace(DataSheetName, "''", "'")

Set DataSheet = Sheets(DataSheetName)    

End Sub

this works in a lot of cases, but if my users have a strange worksheet name (eg Sh'e e$,,t!3!$ ) it fails. the same goes if series 1 has been named (eg .SeriesCollection(1).Formula = "=SERIES(**"Hell,o !"**,'Sh''ee$,,t!3!$'!$B$2:$B$18,'Sh''ee$,,t!3!$'!$C$2:$C$18,1)" .

Is there a simple way to solve this?

Answer 1

I thought this is an easy one, turns out it's not. One of the cases where Excel has the information but will not give it away for free. I ended up with a function like this - maybe this helps:

Function getSheetNameOfSeries(s As Series) As String

Dim f As String, i As Integer
Dim withQuotes As Boolean

' Skip leading comma if not all parts of series is filled. Check if sheetname is in single quotes
For i = 9 To Len(s.Formula)
    If Mid(s.Formula, i, 1) <> "," Then
        If Mid(s.Formula, i, 1) = "'" Then
            withQuotes = True
            f = Mid(s.Formula, i + 1)
        Else
            withQuotes = False
            f = Mid(s.Formula, i)
        End If
        Exit For
    End If
Next i

' "f" now contains a part of the formula with the sheetname as start
' now we search to the end of the sheet name.
' If name is in quotes, we are looking for the "closing" quote
' If not in quotes, we are looking for "!"
i = 1
Do While True

    If withQuotes Then
        ' Sheet name is in quotes, found closes quote --> we're done
        ' (but if next char is also a quote, we have the case the the sheet names contains a quote, so we have to continue working)
        If Mid(f, i, 1) = "'" Then
            If Mid(f, i + 1, 1) <> "'" Then
                getSheetNameOfSeries = Mid(f, 1, i - 1)
                Exit Do
            Else
                i = i + 1       ' Skip 2nd quote
            End If
        End If
    Else
        ' Sheet name is quite normal, so "!" will indicate the end of sheetname
        If Mid(f, i, 1) = "!" Then
            getSheetNameOfSeries = Mid(f, 1, i - 1)
            Exit Do
        End If
    End If

    i = i + 1
Loop

getSheetNameOfSeries = Replace(getSheetNameOfSeries, "''", "'")

End Function

Answer 2

You can use the Find function to look for the values of SeriesCollection(1) .

In the worksheet that hold the data of SeriesCollection(1) , you will be able to find all the values in that array.

More explanations inside the code below.

Code

Option Explicit

Sub GetChartDataSheet()

Dim DataSheetName As String
Dim DataSheet As Worksheet
Dim ws As Worksheet
Dim ValuesArr As Variant, Val As Variant
Dim FindRng As Range
Dim ShtMatch As Boolean

Dim ChtObj As ChartObject
Dim Ser As Series

' if you want to use ActiveChart
Set ChtObj = ActiveChart.Parent

Set Ser = ChtObj.Chart.SeriesCollection(1)
ValuesArr = Ser.Values ' get the values of the Series Collection inside an array

' use Find to get the Sheet's origin
For Each ws In ThisWorkbook.Sheets
    With ws
        ShtMatch = True
        For Each Val In ValuesArr ' loop through all values in array
            Set FindRng = .Cells.Find(what:=Val) ' you need to find each value in the worksheet that SeriesCollection data is tied to
            If FindRng Is Nothing Then
                ShtMatch = False
                Exit For
            End If
            Set FindRng = Nothing ' reset
        Next Val

        If ShtMatch = True Then
            Set DataSheet = ws
            Exit For
        End If
    End With
Next ws
DataSheetName = DataSheet.Name

End Sub