Need help with VBA loop function

[Akbarov]

Hello dear community,
I need help with loop function in following VBA

Sub ColorOfChart()

    Dim chrt As Chart, i As Long, clr As Long
    Dim r As Byte, g As Byte, b As Byte
 
    Set chrt = Sheet31.ChartObjects(1).Chart
                
    For i = 1 To chrt.SeriesCollection.Count
        clr = Sheet31.Cells(68, i).Interior.Color
        r = clr Mod 256
        g = clr \ 256 Mod 256
        b = clr \ 65536 Mod 256
        chrt.SeriesCollection(i).Format.Fill.ForeColor.RGB = RGB(r, g, b)
     Next i
 
End Sub

How can I make this part "Sheet31.ChartObjects(1).Chart"
to be
Sheet31.ChartObjects(2).Chart
Sheet31.ChartObjects(3).Chart
Sheet31.ChartObjects(4).Chart
etc.. There are around 50 chart objects.

Can anyone help me please?

 

[Akbarov]

Can you tell me how can i use loop by chart name instead of chart id?
Chart names are Cluster1,Cluster2 ...3 ...4 to Cluster54

I see this is related to your recent question here:

VBA Chart series color based on cell color

Hello Dear community, I want to know is there a way to make my chart series color dynamic? So let's say A2:T2 are cells with different colors. I want My Series 1 to change it is color based on cell A2 color My Series 2 to change it is color based on cell B2 color and so on I tried this code...

www.mrexcel.com

You are not saying which are the data ranges for each chart and their respective colored cells.

 

[Jaafar Tribak]

Can you tell me how can i use loop by chart name instead of chart id?
Chart names are Cluster1,Cluster2 ...3 ...4 to Cluster54

Before we proceed, did the last code (post#10) work for you ?

 

[Akbarov]

The iimage shot is not very clear but If you have 10 series in each chart and the colored cells start in cell F68 then you may try the following :

Sub ColorOfChart()
    Dim chrtObj As Object
    Dim chrt As Chart, i As Long, j As Long, clr As Long
    Dim r As Byte, g As Byte, b As Byte

    For Each chrtObj In Sheet31.ChartObjects
        Set chrt = chrtObj.Chart
        For i = 1 To chrt.SeriesCollection.Count
            clr = Sheet31.Cells(68, i + 5 + j).Interior.Color
            r = clr Mod 256
            g = clr \ 256 Mod 256
            b = clr \ 65536 Mod 256
            chrt.SeriesCollection(i).Format.Fill.ForeColor.RGB = RGB(r, g, b)
        Next i
        j = j + 10
    Next
End Sub

Thank you for code. I noticed that ID numbers of charts are messed up.. it goes like 1,3,2,4,5 etc. Is it possible to loop by chart names?

 

[Akbarov]

Before we proceed, did the last code (post#10) work for you ?

I used following code.
All charts changed color , but all chart had same color ( colors which I used for 1st chart )
When I used your code there was problem I think because ID numbers are not sorted serially.

Sub ColorOfChart()
    Dim chrt As Chart, i As Long, clr As Long
    Dim r As Byte, g As Byte, b As Byte
    Dim x As Long

    For x = 1 To 54    'Change here to suit your number of charts
        Set chrt = Sheet31.ChartObjects(x).Chart

        For i = 1 To chrt.SeriesCollection.Count
            clr = Sheet31.Cells(68, i + 5).Interior.Color
            r = clr Mod 256
            g = clr \ 256 Mod 256
            b = clr \ 65536 Mod 256
            chrt.SeriesCollection(i).Format.Fill.ForeColor.RGB = RGB(r, g, b)
        Next i
    Next x
End Sub

 

[Akbarov]

Before we proceed, did the last code (post#10) work for you ?

I used following code.
All charts changed color , but all chart had same color ( colors which I used for 1st chart )
When I used your code there was problem I think because ID numbers are not sorted serially.

Sub ColorOfChart()
    Dim chrt As Chart, i As Long, clr As Long
    Dim r As Byte, g As Byte, b As Byte
    Dim x As Long

    For x = 1 To 54    'Change here to suit your number of charts
        Set chrt = Sheet31.ChartObjects(x).Chart

        For i = 1 To chrt.SeriesCollection.Count
            clr = Sheet31.Cells(68, i + 5).Interior.Color
            r = clr Mod 256
            g = clr \ 256 Mod 256
            b = clr \ 65536 Mod 256
            chrt.SeriesCollection(i).Format.Fill.ForeColor.RGB = RGB(r, g, b)
        Next i
    Next x
End Sub

 

[Jaafar Tribak]

Not sure why you would want that but, see if this meets your needs :

Option Explicit

Sub ColorOfChart()
    Dim chrtObj As ChartObject
    Dim i As Long, j As Long, k As Long, clr As Long
    Dim r As Byte, g As Byte, b As Byte
    
    For i = 1 To 54
        Set chrtObj = Sheet31.ChartObjects("Cluster" & i)
        For j = 1 To chrtObj.Chart.SeriesCollection.Count
            clr = Sheet31.Cells(68, j + 5 + k).Interior.Color
            r = clr Mod 256
            g = clr \ 256 Mod 256
            b = clr \ 65536 Mod 256
            chrtObj.Chart.SeriesCollection(j).Format.Fill.ForeColor.RGB = RGB(r, g, b)
        Next j
        k = k + 10
    Next i
End Sub

 

[Akbarov]

Now it works perfectly fine! Thank you very much!

 

[Jaafar Tribak]

Now it works perfectly fine! Thank you very much!

Glad we got this working in the end.

 

[Akbarov]

Glad we got this working in the end.

Jaafar sorry for bothering, I just wanted to make some changes in code, I am stuck again. May be you can help to add 1 line?
I want Chart's bar border style also be same as cells ( row 68 ) border style. I can't figure out how to do that..

Option Explicit

Sub ColorOfChart()
    Dim chrtObj As ChartObject
    Dim i As Long, j As Long, k As Long, clr As Long, brdclr As Borders
    Dim r As Byte, g As Byte, b As Byte
    
    For i = 1 To 54
        Set chrtObj = ActiveSheet.ChartObjects("Cluster" & i)
        For j = 1 To chrtObj.Chart.SeriesCollection.Count
            clr = ActiveSheet.Cells(68, j + 5 + k).Interior.Color
            r = clr Mod 256
            g = clr \ 256 Mod 256
            b = clr \ 65536 Mod 256
            chrtObj.Chart.SeriesCollection(j).Format.Fill.ForeColor.RGB = RGB(r, g, b)
            chrtObj.Chart.SeriesCollection(j).Border.LineStyle = xlContinuous
            chrtObj.Chart.SeriesCollection(j).Format.Line.Weight = 0.5
            chrtObj.Chart.SeriesCollection(j).Border = '<--- need row 68's border style here..
        Next j
        k = k + 10
    Next i
End Sub