Need help with VBA loop function

Akbarov

Active Member
Joined
Jun 30, 2018
Messages
347
Office Version
  1. 365
Platform
  1. Windows
Hello dear community,
I need help with loop function in following VBA

VBA Code:
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?
 
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:

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

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
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 ?
 
Upvote 0
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 :
VBA Code:
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?
 
Upvote 0
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.
VBA Code:
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
 
Upvote 0
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.
VBA Code:
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
 
Upvote 0
Not sure why you would want that but, see if this meets your needs :

VBA Code:
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
 
Upvote 0
Solution
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..
VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,710
Members
448,293
Latest member
jin kazuya

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