Home > OS >  Colour bar charts; Not sure if I am collecting the correct range?
Colour bar charts; Not sure if I am collecting the correct range?

Time:11-17

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
  • Related