Here is a simple example that worked for me on a scatter chart with four
series, all separate regions on the sheet. It probably needs work to do what
you want, including bullet proofing and extension to other sheets or
workbooks, which I didn't check. If you can link it to selecting the chart
somehow, then you can also create an "undo" method that links to de-selection
of the chart and returns the cells back to their original formatting. This
would require you to save the original formatting of the cells somehow, a
problem I'll let you figure out!
HTH,
Eric
'
' This macro puts a bright red border around each range
' of data used in a chart
'
Sub Highlight_Chart_Cells()
Dim i As Long, j As Long
Dim thisChart As Chart
Dim Range1 As Range, Range2 As Range, Range3 As Range
'
Set thisChart = ActiveChart
For i = 1 To thisChart.SeriesCollection.Count
Call Split_Series_Ranges(thisChart.SeriesCollection(i).Formula,
Range1, Range2, Range3)
'
' If a range exists, highlight it with a bright red, thick border
'
If (Not Range1 Is Nothing) Then
For j = 1 To Range1.Areas.Count ' Highlight each area
separately...
With Range1.Areas(j)
.BorderAround xlSolid, xlThick, 3
End With
Next j
End If
'
If (Not Range2 Is Nothing) Then
For j = 1 To Range2.Areas.Count ' Highlight each area
separately...
With Range2.Areas(j)
.BorderAround xlSolid, xlThick, 3
End With
Next j
End If
'
If (Not Range3 Is Nothing) Then
For j = 1 To Range3.Areas.Count ' Highlight each area
separately...
With Range3.Areas(j)
.BorderAround xlSolid, xlThick, 3
End With
Next j
End If
'
Next i
'
End Sub
'
' This subroutine takes as input the formula for one series on a
' chart and returns as output the three ranges (if they all exist)
' that make up the series: the title, the x-values and the y-values.
'
Sub Split_Series_Ranges(inFormula As String, Range1 As Range, Range2 As
Range, Range3 As Range)
Dim i As Integer, j As Integer
Dim tStr As String
'
i = InStr(1, inFormula, "(")
j = InStr(1, inFormula, ",")
If (j - i > 1) Then ' Title range exists
Set Range1 = Range(Mid(inFormula, i + 1, j - i - 1))
Else
Set Range1 = Nothing
End If
'
i = j
j = InStr(i + 1, inFormula, ",")
If (j - i > 1) Then ' Category range exists
Set Range2 = Range(Mid(inFormula, i + 1, j - i - 1))
Else
Set Range2 = Nothing
End If
'
i = j
j = InStr(i + 1, inFormula, ",")
If (j - i > 1) Then ' Value range exists
Set Range3 = Range(Mid(inFormula, i + 1, j - i - 1))
Else
Set Range3 = Nothing
End If
'
End Sub
