pick a new interior color from an array when next color is needed

[pmyk]

I am preparing a long report.
Each time I want to colour a cell I would like to run a subroutine to pick up the next colour code from an array. So, whenever I need a colour cell it will have a different colour.
I am using the following code using the numbers of the interior color.


Private Sub cmdClrWithVariable_Click()
Dim Src As Worksheet 'Colour Names
Set Src = Sheets("IntrClrWithVar")
Src.Select
Dim sClrNum As String
Dim ClrArrPosition As Integer
Dim ClrArr() As String
Dim rownumr As Integer
sClrNum = "19,20,37,38,39,40"
ClrArr = Split(sClrNum, ",")
ClrArrPosition = 3
Src.Range("a15").Interior.ColorIndex = ClrArr(ClrArrPosition)
'[some code here]
ClrArrPosition = 4
Src.Range("a20").Interior.ColorIndex = ClrArr(ClrArrPosition)
'[some code here]
End Sub

Is there any other simpler way? If so, I request any expert to please help me to edit this code. Thanks in advance.

[Dave]

Maybe something like this general format...

rngarray = "a15,a20" 'etc.
splitrngarray = Split(rngarray, ",")
ClrArr = Split(sClrNum, ",")
For Cnt = LBound(splitrngarray) To UBound(splitrngarray)
Src.Range(splitrngarray(Cnt)).Interior.ColorIndex = ClrArr(Cnt)
'[some code here]
Next Cnt
HTH. Dave

[Paul_Hossler]

Little confused since you seem to have colors on a sheet named "InterClrWithVar"

This is in an ActiveX command button





Option Explicit


Public iLastColor As Long


Private Sub CommandButton1_Click()
Dim wsColors As Worksheet 'Colour Names on a normally hidden sheet
Dim rColors As Range

If Not TypeOf Selection Is Range Then Exit Sub

Set wsColors = Sheets("IntrClrWithVar")
Set rColors = wsColors.Cells(1, 1).CurrentRegion

iLastColor = iLastColor + 1
If iLastColor = rColors.Rows.Count Then
iLastColor = 1
End If

Selection.Interior.ColorIndex = rColors.Cells(iLastColor, 2)


End Sub

[pmyk]

Paul_Hossler (http://www.vbaexpress.com/forum/member.php?9803-Paul_Hossler)
http://www.vbaexpress.com/forum/images/statusicon/user-offline.png
Thanks for the suggestion and for the attachment.
This is what I expected.
It works fine.
I have altered your code according to my requirement.
I am also giving suggestions to some, as it helps me to improve my skill.
But I am still learning.
Thanks for taking pains to prepare the attachment file.

[pmyk]

Dave (http://www.vbaexpress.com/forum/member.php?1732-Dave)
http://www.vbaexpress.com/forum/images/statusicon/user-offline.png
Thanks for the code.
My code will prepare sets of rows with a groups of data. Each group will have a heading. The Caption in this heading row will be coloured.
The number of rows for each group will differ. So, only during run time, the cell address will be known which will have the heading of the next group of data.
Hence, for this purpose I may not be able to use your code.
But, there are certain rows which address I already know. These rows will have common Captions and the Cells having these Captions will be coloured.
So, I will be able to use your code for such rows.
Thanks for sparing your time.

[SamT]

I wrote this code based on your first post, After reading your last post, #5, I'm not sure it will work for you, since it depends on all the cells you want colored to be in column "A". It only works with Column "A".

Anyway... About the code:

Every time the worksheet is opened or selected, (Activated,) the code resets. It also resets when the Workbook is opened.
If you want to start with a color other than the default Opening Color, select any colored cell, (with one of your specified colors,) and the next cell you double click, (in Column "A",) will be colored with the next specified color.
To color any non-colored cell, (in Column "A",) double click it

[pmyk]

SamT (http://www.vbaexpress.com/forum/member.php?6494-SamT)
http://www.vbaexpress.com/forum/images/statusicon/user-offline.pngThanks for the suggestions and also for the Excel Book. When a cell in col A in Sheet1 is clicked, it is coloured. Thanks for the codes in Sheet1.
Regarding the previous code, I am able to edit it according to my needs and it helps me. Thanks.