named range tracking via VB

[JackkG]

Hi all,

Is there any way to track named range in chart. I mean is it possible to detect if a given named range is used within a chart with the help of VBA?

Thanks!

cross-posted here:
http://www.excelforum.com/showthread.php?t=1079879&p=4057886#post4057886
http://www.mrexcel.com/forum/excel-q...ml#post4143670

[mancubus]

hi.

see attached.

Sub vbax_52434_ChartSeriesSourceData()

    Dim wbNamedRanges()
    Dim cht As ChartObject
    Dim SeriesFormula As String, SeriesAddress As String, SeriesRange As String
    Dim i As Long
    
    With ThisWorkbook
        Select Case .Names.Count
            Case Is = 0
                MsgBox "There no named ranges in this workbook!"
                Exit Sub
            Case Else
                ReDim wbNamedRanges(1 To .Names.Count)
                For i = 1 To .Names.Count
                    wbNamedRanges(i) = .Names(i).Name
                Next i
        End Select
    End With
    
    Set cht = Worksheets(1).ChartObjects(1) 'sample chart: named range
    'Set cht = Worksheets(1).ChartObjects(2) 'sample chart: not named range
    
    For i = 1 To cht.Chart.SeriesCollection.Count
        SeriesFormula = cht.Chart.SeriesCollection(i).Formula 
        SeriesAddress = Split(SeriesFormula, ",")(2) '3rd bit in series formula
        SeriesRange = Mid(SeriesAddress, InStr(SeriesAddress, "!") + 1) 'remove wb/ws referenece
        If UBound(Filter(wbNamedRanges, SeriesRange)) > -1 Then
            MsgBox "Chart: " & cht.Name & " / Series: " & cht.Chart.SeriesCollection(i).Name & " / Source Data: " & Filter(wbNamedRanges, SeriesRange)(0) & " / Named Range"
        Else
            MsgBox "Chart: " & cht.Name & " / Series: " & cht.Chart.SeriesCollection(i).Name & " / Source Data: " & SeriesRange & " / Not Named Range!"
        End If
    Next

End Sub

[JackkG]

Hi mancubus,

Thanks for the attached file. and this works really great. Just one tweak to this, what if i want to find if the given named range is used within a chart. I mean in multiple sheets there are named ranges, and say if i want to find one of the named ranges to check if its used in chart, how to go about this in VBA?

Thanks!

[JackkG]

Or the given code does the same?

[mancubus]

the code detects if a named range (either workbook or worksheet level) is used as source data and pops up a message box stating the finding.

in the workbook i posted there are two sample charts with the same source data.

in the first chart named ranges are used whereas in the second normal ranges are used.

select chart 1. click Design in Chart Tools tab in ribbon. click Data Source in Data group. click FirstSeries in Legend entries. finally click Edit. Edit Series dialog pops up and you can see Series Values as =vbax_52434_ChartRange.xlsm!First (if you repeat these for SecondSeries the range formula is =vbax_52434_ChartRange.xlsm!Second)

and if you select chart 2 and repeat these actions you will see the range formulas as =Sheet1!$B$2:$B$9 and =Sheet1!$C$2:$C$9 respectively.

if you open name manager (Formulas tab, Defined Names group) you can see there ranges are named as First and Second respectively.

to see the difference in the code, comment out (put a single quotation mark ' at the beginning) the line Set cht = Worksheets(1).ChartObjects(1) and uncomment (remove the single quotation mark ') the line Set cht = Worksheets(1).ChartObjects(2). then run the code again.

[JackkG]

Okay, got it. Thanks a lot for your help!!

[mancubus]

you are welcome.

if you are sorted please mark the thread as solved from Thread Tools dropdown for future references.

[JackkG]

Hi mancubus,

You helped me out with a code for how to track named ranges in a chart. For your below code, can you help me modify the code so that it can find named ranges in a chart in any of sheets in a workbook where chart is available.

Thanks!

Here is your code:

Sub vbax_52434_ChartSeriesSourceData() 
     
     
    Dim wbNamedRanges() 
    Dim cht As ChartObject 
    Dim SeriesFormula As String, SeriesAddress As String, SeriesRange As String 
    Dim i As Long 
     
    With ThisWorkbook 
        Select Case .Names.Count 
        Case Is = 0 
            MsgBox "There no named ranges in this workbook!" 
        Case Else 
            ReDim wbNamedRanges(1 To .Names.Count) 
            For i = 1 To .Names.Count 
                wbNamedRanges(i) = .Names(i).Name 
            Next i 
        End Select 
    End With 
     
    Set cht = Worksheets(1).ChartObjects(1) 'named range
     'Set cht = Worksheets(1).ChartObjects(2) 'not named range
     
    For i = 1 To cht.Chart.SeriesCollection.Count 
        SeriesFormula = cht.Chart.SeriesCollection(i).Formula 
        SeriesAddress = Split(SeriesFormula, ",")(2) '3rd bit in series formula
        SeriesRange = Mid(SeriesAddress, InStr(SeriesAddress, "!") + 1) 'remove wb/ws referenece
        If UBound(Filter(wbNamedRanges, SeriesRange)) > -1 Then 
            MsgBox "Chart: " & cht.Name & " / Series: " & cht.Chart.SeriesCollection(i).Name & " / Source Data: " & Filter(wbNamedRanges, SeriesRange)(0) & " / Named Range" 
        Else 
            MsgBox "Chart: " & cht.Name & " / Series: " & cht.Chart.SeriesCollection(i).Name & " / Source Data: " & SeriesRange & " / Not Named Range!" 
        End If 
    Next 
     
     
End Sub

[mancubus]

Sub vbax_52434_ChartSeriesSourceDataAllChartsWB()

    Dim wbNamedRanges()
    Dim cht As ChartObject, ws As Worksheet
    Dim SeriesFormula As String, SeriesAddress As String, SeriesRange As String
    Dim i As Long, j As Long
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    
    With ThisWorkbook
        Select Case .Names.Count
            Case Is = 0
                MsgBox "There no named ranges in this workbook!"
            Case Else
                ReDim wbNamedRanges(1 To .Names.Count)
                For i = 1 To .Names.Count
                    wbNamedRanges(i) = .Names(i).Name
                Next i
        End Select
    End With
    
    On Error Resume Next
    Worksheets("Chart_Info").Delete
    On Error GoTo 0
    
    Worksheets.Add(Before:=Worksheets(1)).Name = "Chart_Info"
    Worksheets("Chart_Info").Range("A1:E1").Value = Array("Worksheet_Name", "Chart_Name", "Series_Name", "Source_Data", "Named_Range")
    
    j = 1
    For Each ws In Worksheets
        For Each cht In ws.ChartObjects
            For i = 1 To cht.Chart.SeriesCollection.Count
                j = j + 1
                SeriesFormula = cht.Chart.SeriesCollection(i).Formula
                SeriesAddress = Split(SeriesFormula, ",")(2) '3rd bit in series formula
                SeriesRange = Mid(SeriesAddress, InStr(SeriesAddress, "!") + 1) 'remove wb/ws referenece
                With Worksheets("Chart_Info")
                    .Range("A" & j).Value = ws.Name
                    .Range("B" & j).Value = cht.Name
                    .Range("C" & j).Value = cht.Chart.SeriesCollection(i).Name
                    If UBound(Filter(wbNamedRanges, SeriesRange)) > -1 Then
                        .Range("D" & j).Value = Filter(wbNamedRanges, SeriesRange)(0)
                        .Range("E" & j).Value = "Yes"
                    Else
                        .Range("D" & j).Value = SeriesAddress
                        .Range("E" & j).Value = "No"
                    End If
                End With
            Next i
        Next cht
    Next ws

    Worksheets("Chart_Info").Columns.AutoFit

End Sub




Sub vbax_52434_ChartSeriesSourceDataSingleChart()

    Dim wbNamedRanges()
    Dim cht As ChartObject
    Dim SeriesFormula As String, SeriesAddress As String, SeriesRange As String
    Dim i As Long
    
    With ThisWorkbook
        Select Case .Names.Count
            Case Is = 0
                MsgBox "There no named ranges in this workbook!"
            Case Else
                ReDim wbNamedRanges(1 To .Names.Count)
                For i = 1 To .Names.Count
                    wbNamedRanges(i) = .Names(i).Name
                Next i
        End Select
    End With
    
    Set cht = Worksheets("Sheet1").ChartObjects(1) 'named range
    'Set cht = Worksheets("Sheet1").ChartObjects(2) 'not named range
    
    For i = 1 To cht.Chart.SeriesCollection.Count
        SeriesFormula = cht.Chart.SeriesCollection(i).Formula
        SeriesAddress = Split(SeriesFormula, ",")(2) '3rd bit in series formula
        SeriesRange = Mid(SeriesAddress, InStr(SeriesAddress, "!") + 1) 'remove wb/ws referenece
        If UBound(Filter(wbNamedRanges, SeriesRange)) > -1 Then
            MsgBox "Chart: " & cht.Name & " / Series: " & cht.Chart.SeriesCollection(i).Name & " / Source Data: " & Filter(wbNamedRanges, SeriesRange)(0) & " / Named Range"
        Else
            MsgBox "Chart: " & cht.Name & " / Series: " & cht.Chart.SeriesCollection(i).Name & " / Source Data: " & SeriesAddress & " / Not Named Range!"
        End If
    Next

End Sub

[JackkG]

Wow!!!! That's great of you!! Thanks a lot mancubus!!

[mancubus]

you are welcome. i'm glad it helped.