For Each srs in cht.seriescollection not working

[MikeZz]

Hi,
I have a very complex chart with about 400 lines on X-Y chart.
The issue is that not all the series have the same range as the "XValue" so
if I autofilter the data, it hides the Xvalue range on some series and so it
doesn't scale hte X-Axis correctly.

Because if this, I want to search through all the series where the data
comes from a worksheet with "data" in the name. Find the series that has the
"xValue" row at the top of the page and then set all the other data series
X-Values to the one at the top of the row.

Not all series point to the same data worksheet and there could be other
issues (I didn't build the chart).

Any help would be great!

Dim rngDataSource As Range
Dim iDataRowsCt As Long
Dim iDataColsCt As Integer
Dim iSrsIx As Integer
Dim chtChart As Chart
Dim srsNew As Series
Dim rngXVal As Range
Dim addXVals
Dim dataSheetName
Dim topXval
Dim thisXvalRow
Dim sCount

dataSheetName = "data"
topXval = 1000
Application.ScreenUpdating = False
Set cht = ActiveChart
If cht.ChartType = 0 Then Exit Sub

For Each srs In cht.SeriesCollection

addXVals = Extract_Series_Ranges(srs.FormulaR1C1, "X")

If InStr(1, srs.Name, "ARC") = 0 And InStr(1, srs.Name, "RIM") =
0 Then
If InStr(1, addXVals, dataSheetName) > 0 Then
thisXvalRow = Range(addXVals).Row
If thisXvalRow < topXval Then
topXval = thisXvalRow

End If

End If

End If

Next
Application.ScreenUpdating = True


End Sub


Private Function Extract_Series_Ranges(SerForm, XorY)
Dim comma1, comma2, comma3, comma4
Dim xRange
Dim yRange
Dim nRange
Dim par1
Dim Ord

par1 = InStr(1, SerForm, "(")
comma1 = InStr(1, SerForm, ",")
comma2 = InStr(comma1 + 1, SerForm, ",")
comma3 = InStr(comma2 + 1, SerForm, ",")
comma4 = InStr(comma3 + 1, SerForm, ",")

nRange = Mid(SerForm, par1 + 1, comma1 - par1 - 1)
xRange = Mid(SerForm, comma1 + 1, comma2 - comma1 - 1)
yRange = Mid(SerForm, comma2 + 1, comma3 - comma2 - 1)
Ord = Mid(SerForm, comma3 + 1, Len(SerForm) - comma3 - 1)

Select Case XorY
Case "X"
Extract_Series_Ranges = xRange
Case "Y"
Extract_Series_Ranges = yRange
Case "Name"
Extract_Series_Ranges = nRange
Case "Ord"
Extract_Series_Ranges = Ord
End Select


End Function

 

[Barb Reinhardt]

I use this to list the series on a new worksheet. I hope it helps.

Sub ChartSeriesListEmbedded()
Dim WS As Excel.Worksheet
Dim objCht As Excel.ChartObject
Dim xVal, yVal, SeriesFormula
Dim k, i
Dim lRow
Dim myWS As Excel.Worksheet
Dim aWB As Excel.Workbook
Dim myCount As Long

Set aWB = ActiveWorkbook
myCount = aWB.Charts.Count
For Each WS In aWB.Worksheets
myCount = WS.ChartObjects.Count + myCount
Next WS

If myCount = 0 Then
MsgBox ("There are no charts in the active workbook. Execution ending.")
End
End If

'MsgBox ("This procedure adds a worksheet")

aWB.Unprotect
On Error Resume Next
Set myWS = aWB.Worksheets("SeriesList")
On Error GoTo 0

If Not myWS Is Nothing Then
Application.DisplayAlerts = False
myWS.Delete
Application.DisplayAlerts = True
End If

Set myWS = aWB.Worksheets.Add(Before:=aWB.Worksheets(1))
myWS.Name = "SeriesList"
'lRow = Worksheets("SeriesList").Cells(Rows.Count, "a").End(xlUp).row
myWS.Cells(1, 1) = "Worksheet Name"
myWS.Cells(1, 2) = "Chart Name"
myWS.Cells(1, 3) = "Series Number"
myWS.Cells(1, 4) = "Series Formula"

lRow = 1

For Each WS In aWB.Worksheets
WS.Activate

For Each objCht In WS.ChartObjects
Debug.Print objCht.Name
With objCht.Chart
Debug.Print "count=", .SeriesCollection.Count
For k = 1 To .SeriesCollection.Count
'xVal = .SeriesCollection(k).XValues
'yVal = .SeriesCollection(k).Values
On Error Resume Next
SeriesFormula = "No data in series. Check manually"
SeriesFormula = .SeriesCollection(k).Formula
On Error GoTo 0
'Debug.Print WS.Name; " has chart; "; .Parent.Name; _
".; Series"; k; "; formula"; seriesformula
myWS.Range("a" & lRow + 1).Value = WS.Name
myWS.Range("b" & lRow + 1).Value = .Parent.Name
myWS.Range("c" & lRow + 1).Value = k
myWS.Range("d" & lRow + 1).Value = "'" & SeriesFormula
lRow = lRow + 1
Next k
End With
Next
Next WS
myWS.Select
myWS.Rows(1).Font.Bold = True
myWS.Rows(1).AutoFilter
myWS.UsedRange.EntireColumn.AutoFit

MsgBox ("Series List population complete.")

End Sub

 

[Jon Peltier]

You didn't tell us what "not working" means.

- Jon