VBA to find and locate #REF! within excel chart series source data / formulae

JimmyM1975

New Member
Joined
Feb 11, 2021
Messages
7
Office Version
  1. 2019
Platform
  1. Windows
Hi. Can anyone help? We are looking for some excel based VBA that can run a FIND fuction (not FIND+REPLACE) across thousands of charts with millions of series in one go to find whatever is intered into the InputBox (eg #REF! to find broken links)?

I am not great at VBA but I have about 20 quite advanced 100MB+ excel workbooks that contain up to 100 sheets and over 20,000 charts. We run API automation to update data monthly into excel from various websites around the world, this updates all the charts and then we update the links in about 20 Powerpoints to get the latest iteration of the 1,200k charts contained therein. With 30-40 years of historic data, the files have millions of data points and cells which makes finding an error like looking for a needle in a haystak. It all works quite well until someone accidentally deletes a row / cell / column in error which causes #REF! within the series formulae of some chart, as has happned recently putting into massive disarray. Finding these charts is problematic and after days we still cannot find the source of the "excel found a problem with one or more formula references in this worksheet" warning. As FIND or FIND+REPLACE doesn't work within chart series, we have used some excellent Jon Pellteir VBA Change Series Formula - Improved Routines - Peltier Tech VBA as a workaround which runs and instant FIND + REPLACE within all charts in the sheet or book (he has a VBA for each option) and allows us to remove the #REF! but this doesn't help us fix the problem as it doesn't tell us where the physical location of the problem chart itself actually is (ie what sheet and what cell its sits on) - by the way all our charts are "embedded charts" in the worksheets themselves (and are not standalone "chart sheets").

Can anyone helps us with how to FIND (locate) the problem chart. We are trying to write some VBA (and failing) that would run across all charts in all sheets to run a FIND ONLY function (not FIND+REPLACE).. Ideally the VBA would bring up an InputBox (eg xFindStr = Application.InputBox("Find:"... ) and we could type XXX (eg #REF!, or something else) and then the VBA would take us to the FIRST chart that it finds with what we had entered into the InputBox (eg #REF!, or something else) and it would also SELECT that chart which would help us find the needle in the haystack). We could then manually ammend it. As we have many charts, it would be cool if the VBA could group select all that charts that contained what was entered in the InputBox (eg #REF!, or something else) and not just the first - but maybe that is asking too much.

I would very grateful if anyone can help.
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
See if this works for you. It is based on the Jon Peltier code you provided the link for.
It creates a new sheet with the details for where the search string was found

VBA Code:
' https://peltiertech.com/change-series-formula-improved-routines/
Sub FindTextAllChartsAllSheets()
    ''' Do all charts in all sheets
    Dim oWksht As Worksheet
    Dim oChart As ChartObject
    Dim findString As String
    Dim mySrs As Series
    
    Dim outWksht As Worksheet
    Dim outRow As Long
    Dim outHdgs As String
    
    ' Output parameters
    Worksheets.Add before:=Worksheets(1)
    Set outWksht = ActiveSheet
    outHdgs = "Chart Name, Sheet Name, Formula"
    Hdgs = Split(outHdgs, ",")
    outRow = 1

    findString = InputBox("Enter the string to find:", "Enter string to search for")

    If Len(findString) > 1 Then

        For Each oWksht In ActiveWorkbook.Worksheets
            For Each oChart In oWksht.ChartObjects
                For Each mySrs In oChart.Chart.SeriesCollection
                    If InStr(1, mySrs.Formula, findString, vbTextCompare) > 0 Then
                        outRow = outRow + 1
                        outWksht.Cells(outRow, 1).Value = oChart.Name
                        outWksht.Cells(outRow, 2).Value = oChart.Parent.Name
                        outWksht.Cells(outRow, 3).Value = "'" & mySrs.Formula
                    End If
                    
                Next
            Next
        Next
    Else
        MsgBox "Nothing to be replaced.", vbInformation, "Nothing Entered"
    End If
    
    With outWksht.Cells(1, 1).Resize(1, UBound(Hdgs) + 1)
        .Value = Hdgs
        .EntireColumn.AutoFit
        .Font.Bold = True
    End With
    
End Sub
 
Upvote 0
Please use this updated version;

VBA Code:
' Based on:
' https://peltiertech.com/change-series-formula-improved-routines/
Sub FindTextAllChartsAllSheets()
    ''' Do all charts in all sheets
    Dim oWksht As Worksheet
    Dim oChart As ChartObject
    Dim findString As String
    Dim mySrs As Series
  
    Dim outWksht As Worksheet
    Dim outRow As Long
    Dim outHdgs As String
    Dim Hdgs As Variant
  
    ' Output parameters
    Worksheets.Add before:=Worksheets(1)
    Set outWksht = ActiveSheet
    outHdgs = "Chart Name, Position,Sheet Name, Formula, Title"
    Hdgs = Split(outHdgs, ",")
    outRow = 1

    findString = InputBox("Enter the string to find:", "Enter string to search for")

    If Len(findString) > 1 Then

        For Each oWksht In ActiveWorkbook.Worksheets
            For Each oChart In oWksht.ChartObjects
                For Each mySrs In oChart.Chart.SeriesCollection
                    If InStr(1, mySrs.Formula, findString, vbTextCompare) > 0 Then
                        outRow = outRow + 1
                        outWksht.Cells(outRow, 1).Value = oChart.Name
                        outWksht.Cells(outRow, 2).Value = oChart.Chart.Parent.TopLeftCell.Address
                        outWksht.Cells(outRow, 3).Value = oChart.Parent.Name
                        outWksht.Cells(outRow, 4).Value = "'" & mySrs.Formula
                        outWksht.Cells(outRow, 5).Value = oChart.Chart.ChartTitle.Text
                      
                    End If
                  
                Next
            Next
        Next
    Else
        MsgBox "Nothing to be found.", vbInformation, "Nothing Entered"
    End If
  
    With outWksht.Cells(1, 1).Resize(1, UBound(Hdgs) + 1)
        .Value = Hdgs
        .EntireColumn.AutoFit
        .Font.Bold = True
    End With
  
End Sub
 
Upvote 0
That is a thing of beauty - thank you so much ... I have just run it on a big AND IT WORKED!!!! I had to remove your fifth output on Chart Name ("outWksht.Cells(outRow, 5).Value = oChart.Chart.ChartTitle.Text) as I dont name the charts the fifth output created an error box and stopped the VBA (FYI - my ammended VBA below incase of use to other readers). Once it did it was plain sailing. HOWEVER, as I had already fixed the #REF! I rebuilt a quick and dirty test excel (see weblink below to access my test excel) - and I ran the VBA and I got the Run-time error pasted below, with the debugger stopping at this line "If InStr(1, mySrs.Formula, findString, vbTextCompare) > 0 Then".

Any thoughts on why?

1632742424131.png





Sub FindTextAllChartsAllSheets()
''' Do all charts in all sheets
Dim oWksht As Worksheet
Dim oChart As ChartObject
Dim findString As String
Dim mySrs As Series

Dim outWksht As Worksheet
Dim outRow As Long
Dim outHdgs As String
Dim Hdgs As Variant

' Output parameters
Worksheets.Add before:=Worksheets(1)
Set outWksht = ActiveSheet
outHdgs = "Chart Name, Position,Sheet Name, Formula, Title"
Hdgs = Split(outHdgs, ",")
outRow = 1

findString = InputBox("Enter the string to find:", "Enter string to search for")

If Len(findString) > 1 Then

For Each oWksht In ActiveWorkbook.Worksheets
For Each oChart In oWksht.ChartObjects
For Each mySrs In oChart.Chart.SeriesCollection
If InStr(1, mySrs.Formula, findString, vbTextCompare) > 0 Then
outRow = outRow + 1
outWksht.Cells(outRow, 1).Value = oChart.Name
outWksht.Cells(outRow, 2).Value = oChart.Chart.Parent.TopLeftCell.Address
outWksht.Cells(outRow, 3).Value = oChart.Parent.Name
outWksht.Cells(outRow, 4).Value = "'" & mySrs.Formula

End If

Next
Next
Next
Else
MsgBox "Nothing to be found.", vbInformation, "Nothing Entered"
End If

With outWksht.Cells(1, 1).Resize(1, UBound(Hdgs) + 1)
.Value = Hdgs
.EntireColumn.AutoFit
.Font.Bold = True
End With

End Sub
 
Upvote 0
Your link didn't work for me. I don't think you made it available to everyone who has the link ie a public setting.
Can you change the setting or do a new link and resend. If you are using a work sharepoint, the admin settings may prevent you from sharing it.

If that is the case tell me what you typed into the input box and what you did to create a test scenario.
 
Last edited:
Upvote 0
Your link didn't work for me. I don't think you made it available to everyone who has the link ie a public setting.
Can you change the setting or do a new link and resend. If you are using a work sharepoint, the admin settings may prevent you from sharing it.

If that is the case tell me what you typed into the input box and what you did to create a test scenario.
Yes my admin rights only allow if you receive the email... So I built a simple chart in excel using the first 5 rows below THEN wenty into the 'Select Data' legend and clicked 'ADD'. Then in the new Series Name I selected XXX for Name and 6,6,7,7,9 for data. Adding a fisth series (A,B,C,D,E,F being horizontal axis labels) THEN I highlight the entire row of the sheet with XXX on in excel (outside of the chart) and hit delete. This created a #REF! in the fith series as per below. I then tried to run the macro (VBA) and got the message above.


ABCEF
Rob
345​
55​
56​
8​
5​
Chris
3​
56​
456​
7​
56​
Simon
3​
34​
34​
456​
4​
Tom
7​
8​
79​
34​
9​
XXXX
6​
6​
7​
7​
9​


1632745887159.png
 
Upvote 0
Can you try this.
If the formula is invalid and has #REF! in it, it is not allowing me to retrieve the formula and is what is giving you that error.
I have put error trapping around it and am outputting some text that should still work for a #REF! search, might not work for all searches but I just can't get to the formula.

I have put the title code back but also wrapped in error trapping so it will print it if there and ignore it if not.

VBA Code:
' Based on:-
' https://peltiertech.com/change-series-formula-improved-routines/
Sub FindTextAllChartsAllSheets()
    ''' Do all charts in all sheets
    Dim oWksht As Worksheet
    Dim oChart As ChartObject
    Dim findString As String
    Dim mySrs As Series
    Dim SrsFormula As String
    
    Dim outWksht As Worksheet
    Dim outRow As Long
    Dim outHdgs As String
    Dim Hdgs As Variant
    
    ' Output parameters
    Worksheets.Add before:=Worksheets(1)
    Set outWksht = ActiveSheet
    outHdgs = "Chart Name, Position,Sheet Name, Formula, Title"
    Hdgs = Split(outHdgs, ",")
    outRow = 1
    
    findString = InputBox("Enter the string to find:", "Enter string to search for")
    
    If Len(findString) > 1 Then
    
    For Each oWksht In ActiveWorkbook.Worksheets
        For Each oChart In oWksht.ChartObjects
            For Each mySrs In oChart.Chart.SeriesCollection
            
                On Error Resume Next
                SrsFormula = ""
                SrsFormula = mySrs.Formula
                On Error GoTo 0
                If SrsFormula = "" Then SrsFormula = "ERROR IN FORMULA #REF!"
                If InStr(1, SrsFormula, findString, vbTextCompare) > 0 Then
                    outRow = outRow + 1
                    outWksht.Cells(outRow, 1).Value = oChart.Name
                    outWksht.Cells(outRow, 2).Value = oChart.Chart.Parent.TopLeftCell.Address
                    outWksht.Cells(outRow, 3).Value = oChart.Parent.Name
                    outWksht.Cells(outRow, 4).Value = "'" & SrsFormula
                    On Error Resume Next
                    outWksht.Cells(outRow, 5).Value = oChart.Chart.ChartTitle.Text
                    On Error GoTo 0
                
                End If
            
            Next
        Next
    Next
    Else
    MsgBox "Nothing to be found.", vbInformation, "Nothing Entered"
    End If
    
    With outWksht.Cells(1, 1).Resize(1, UBound(Hdgs) + 1)
        .Value = Hdgs
        .EntireColumn.AutoFit
        .Font.Bold = True
    End With

End Sub
 
Upvote 0
Mr Blankenburg - you are a master craftsman - thank you so much it is perfect!!!!!

You made my day. :)

Chart NamePositionSheet NameFormula
RED_Column_042803$BM$1398AnnualERROR IN FORMULA #REF!
RED_Column_093499$BT$717QuarterlyERROR IN FORMULA #REF!
RED_Column_093499$BT$717QuarterlyERROR IN FORMULA #REF!
RED_Column_093499$BT$717QuarterlyERROR IN FORMULA #REF!
RED_Column_093499$BT$717QuarterlyERROR IN FORMULA #REF!
Chart 10$BB$459FXEERROR IN FORMULA #REF!
Chart 10$BB$459FXEERROR IN FORMULA #REF!
Chart 12$BC$472FXEERROR IN FORMULA #REF!
Chart 12$BC$472FXEERROR IN FORMULA #REF!
Chart 13$BC$486FXEERROR IN FORMULA #REF!
Chart 13$BC$486FXEERROR IN FORMULA #REF!
Chart 10$BC$498FXEERROR IN FORMULA #REF!
Chart 10$BC$498FXEERROR IN FORMULA #REF!
Chart 49$AP$48SREERROR IN FORMULA #REF!
Chart 49$AP$48SREERROR IN FORMULA #REF!
Chart 50$AP$53SREERROR IN FORMULA #REF!
Chart 50$AP$53SREERROR IN FORMULA #REF!
Chart 5$CA$48SGRE=SERIES("#REF!",{"1"},{1},1)
Chart 5$CA$48SGRE=SERIES("#REF!",{"1"},{1},2)
Chart 5$CA$48SGRE=SERIES("#REF!",{"1"},{1},3)
 
Upvote 0
Thank you for sharing your results. It was interesting to see that not all instances of #REF! in mySrs.Formula needed the error handling.
Your communication along the way has been exemplary, glad to have been able to help.
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,150
Members
448,552
Latest member
WORKINGWITHNOLEADER

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top