I am struggling with applying a previous bit of code I have used for the same process in a different workbook.
The process is that I have conditionally formatted a set of information (now on a different sheet) to change colour based on whether either "Lab" or "Office" is selected from the drop down list.
I then wanted (what I believe this code should do however I don't believe I have linked the series correctly) the graph which the information is in relation too to change the relevant data points to that colour, highlighting that on this floor you have selected "Office" or "Lab".
The code I am using starts here:
Sub CellColorsToChart()
Dim xChart As Chart
Dim I As Long, J As Long
Dim xRowsOrCols As Long, xSCount As Long
Dim xRg As Range, xCell As Range
On Error Resume Next
Set xChart = ActiveSheet.ChartObjects("Net Internal Area").Chart.Refresh
If xChart Is Nothing Then Exit Sub
xSCount = xChart.SeriesCollection.Count
For I = 1 To xSCount
J = 1
With xChart.SeriesCollection(I)
Set xRg = ActiveSheet.Range(Split(Split(.Formula, ",")(2), "!")(1))
If xSCount > 4 Then
xRowsOrCols = xRg.Columns.Count
Else
xRowsOrCols = xRg.Rows.Count
End If
For Each xCell In xRg
.Points(J).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xCell.DisplayFormat.Interior.ColorIndex)
.Points(J).Format.Line.ForeColor.RGB = ThisWorkbook.Colors(xCell.DisplayFormat.Interior.ColorIndex)
J = J 1
Next
End With
Next
End Sub
Document can be downloaded here: https://wetransfer.com/downloads/fbdb338026e7c42cc08193536270cdfc20211115102313/07937d
Any help or tips on how to understand and read this better would be amazing.
Best Jack
CodePudding user response:
Remove Refresh
from this line Set xChart = ActiveSheet.ChartObjects("Net Internal Area").Chart.Refresh
and refresh chart after If xChart Is Nothing Then Exit Sub
Option Explicit
Sub CellColorsToChart()
Dim xChart As Chart
Dim I As Long, J As Long, ix As Long
Dim xSCount As Long
Dim xRg As Range, xCell As Range
Set xChart = ActiveSheet.ChartObjects("Net Internal Area").Chart
If xChart Is Nothing Then Exit Sub
xChart.Refresh
xSCount = xChart.SeriesCollection.Count
For I = 1 To xSCount
With xChart.SeriesCollection(I)
J = 1
Set xRg = ActiveSheet.Range(Split(Split(.Formula, ",")(2), "!")(1))
For Each xCell In xRg
ix = xCell.DisplayFormat.Interior.ColorIndex
If ix >= 1 Then
.Points(J).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(ix)
.Points(J).Format.Line.ForeColor.RGB = ThisWorkbook.Colors(ix)
End If
J = J 1
Next
End With
Next
End Sub