PDA

View Full Version : [SOLVED] named range tracking via VB



JackkG
04-28-2015, 02:18 PM
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-questions/851865-how-track-named-ranges-chart.html#post4143670

mancubus
04-29-2015, 03:09 AM
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
04-29-2015, 10:18 AM
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
04-29-2015, 10:20 AM
Or the given code does the same?

mancubus
04-29-2015, 02:15 PM
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
04-29-2015, 03:08 PM
Okay, got it. Thanks a lot for your help!! :)

mancubus
04-29-2015, 11:14 PM
you are welcome.

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

JackkG
05-11-2015, 12:47 PM
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
05-12-2015, 12:51 AM
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
05-12-2015, 08:03 AM
Wow!!!! That's great of you!! Thanks a lot mancubus!!

mancubus
05-12-2015, 10:59 PM
you are welcome. i'm glad it helped.