Loop through all charts in workbook

GustavBA

New Member
Joined
Mar 14, 2008
Messages
22
Hi all

I have read some posts here and there about problems with looping through every chart in a workbook. Now I have similar problems and I dont seem to get the suggested alternatives to work better than what I all ready have.

The code I all ready have is code which some other insightfull vba guy on the net have written.

Now the problem I am trying to solve is to breake the links between a chart and its scource data. In my workbook I have several sheets with several charts on them. I want to distribute my workbook to others without the scource data, and that's where trouble begins.

An alternative solution could be to make pictures out of the charts before deleting scource data, but the loop problems would still remais.

Here is the code so far. It runs without errors but fail to loop through all charts:

Code:
Sub break_chart_links()
Dim iCtr As Integer, iChars As Integer, iPlotOrder As Integer
Dim nPts As Long, iPts As Long 'Holds the total no of points in the chart
Dim xArray, yArray, sChtName As String, sSrsName As String
Dim xVals, yVals
Dim ChtSeries As Series ' var used to loop thru the series collection
Dim ws As Worksheet
Dim sChartType As String, iCtr1 As Integer
Dim SH As Shape
 
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
For Each ws In ActiveWorkbook.Worksheets 
ws.Activate
For Each SH In ws.Shapes
On Error Resume Next
SH.Select
If SH.Type = msoChart Then
sChtName = ActiveChart.Name
For Each ChtSeries In ActiveChart.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 NOS IN X ARRAY (REMOVING EXCESS DIGITS)
iChars = WorksheetFunction.Max(InStr(CStr(xVals(iPts)), "."), 5)
xArray = xArray & Left(CStr(xVals(iPts)), iChars) & ","
Else
'PUTTING QUOTES AROUND STRING VALUES
xArray = xArray & """" & xVals(iPts) & ""","
End If
'SAME AS X (ABOVE)
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
' NEED TO ROUND NUMBERS ELSE THROWS ERROR
yArray = yArray & Round(Left(CStr(yVals(iPts)), iChars), 0) & ","
End If
Next
'REMOVE FINAL COMMA
xArray = Left(xArray, Len(xArray) - 1)
yArray = Left(yArray, Len(yArray) - 1)
 
With ChtSeries
.Values = yArray
.XValues = xArray
.Name = sSrsName
.PlotOrder = iPlotOrder
End With 
 
Next
End If
Next SH 
Next 
End Sub
In stead of using For each I have tried for i = 1 to ws.ChartObjects.Count but with no improvement.
 
Last edited:

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

GustavBA

New Member
Joined
Mar 14, 2008
Messages
22
Now this showed out to be pretty simple after all.

This showed to work:

Rich (BB code):
Sub break_chart_links()
Dim iCtr As Integer, iChars As Integer, iPlotOrder As Integer
Dim nPts As Long, iPts As Long 'Holds the total no of points in the chart
Dim xArray, yArray, sChtName As String, sSrsName As String
Dim xVals, yVals
Dim ChtSeries As Series ' var used to loop thru the series collection
Dim ws As Worksheet
Dim sChartType As String, iCtr1 As Integer
Dim SH As Shape
Dim shp As Shape, chtObj As ChartObject, cht As Chart
 
 
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
For Each ws In ActiveWorkbook.Worksheets 
ws.Activate
For i = 1 To ActiveSheet.ChartObjects.Count
On Error Resume Next
ActiveSheet.ChartObjects(i).Select
If ActiveChart.Type = msoChart Then 
 
Set chtObj = shp.DrawingObject
Set cht = chtObj.Chart
sChtName = ActiveChart.Name
For Each ChtSeries In ActiveChart.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 NOS IN X ARRAY (REMOVING EXCESS DIGITS)
iChars = WorksheetFunction.Max(InStr(CStr(xVals(iPts)), "."), 5) 
xArray = xArray & Left(CStr(xVals(iPts)), iChars) & ","
Else
'PUTTING QUOTES AROUND STRING VALUES
xArray = xArray & """" & xVals(iPts) & ""","
End If
'SAME AS X (ABOVE)
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
' NEED TO ROUND NUMBERS ELSE THROWS ERROR
yArray = yArray & Round(Left(CStr(yVals(iPts)), iChars), 0) & ","
End If
Next
'REMOVE FINAL COMMA
xArray = Left(xArray, Len(xArray) - 1)
yArray = Left(yArray, Len(yArray) - 1)
 
With ChtSeries
.Values = yArray
.XValues = xArray
.Name = sSrsName
.PlotOrder = iPlotOrder
End With 
 
Next
End If
Next i 
 
Next
 
ActiveWorkbook.Save
 
' Call Get_wb_ready_for_distribution
 
End Sub
 

GustavBA

New Member
Joined
Mar 14, 2008
Messages
22
#¤%#¤% Disregard my last post. That code didn't "remember" looping through all charts afterall. :mad:
 

Watch MrExcel Video

Forum statistics

Threads
1,095,201
Messages
5,443,002
Members
405,212
Latest member
Arnie58

This Week's Hot Topics

  • Copy entire row if CountA <>0 to another sheet
    [B]I want to copy entire row if CountA <>0 for column J7:AM7 (headers on J6:AM6) and so on till the last used cell is column D and paste the...
  • Select last used Row in Table
    I have created a Table in a Worksheet which is locked to prevent user errors and protect formula. Some of the cells require freetext entries which...
  • excel workbook: do not allow certain file name
    Hello all, Don't think this has ever been asked before, but how do I restrict file save [Before_Save Event] if the name of the file being saved...
  • fixing problem autofilter
    hello i need help about my code when i search by code in textbox it doesn't show anything this is my data [ATTACH type="full"...
  • “Weight”
    Hi, i’ve got a long sheet filled with weights such as kg,g,L & ml. i can build a formula to convert kg into g and liter into ml. How ever, my...
  • How to capitalize everything before a certain character?
    In column A, I have some text: Hello good day.mp3 Hello good day.flac etc. I'd like to capitalize everything before the period. I don't need the...
Top