Skip to main content
5 of 13
Added skip black color option in the function
Naresh
  • 305
  • 2
  • 13

VBA function returning array for RGB color combinations

Submitting for review by experts.

Inspired by this question to color value cell having duplicates with a different color. So "Apple" will have one color for all duplicates. Then "Banana" will have a different color for all its duplicates. What if number of such values exceeds 56 (max number of ColorIndex property ?

With this function I am trying to create array of all possible combinations in a given range and step of RGB colors in VBA.

Starting from 1 and ending 255 there are 256*256*256 = 16,777,216 (1 added for absence of color, 0) unique combinations of RGB colors. More than enough for all excel rows :) Refer this stackoverflow link

Function RGBColorArray(StartCol As Byte, EndCol As Byte, ColStep As Byte, Optional Skip_Black As Boolean = False) As Variant
'This function gives array of combinations of colors
'Function will return error if StartCol or EndCol > 255
'StartCol is the color number from where to start. Say 150
'EndCol is the color number where to end. Say 220
'ColStep is the desired gap/interval between the two consecutive color numbers
'If every color combination is desired then ColStep = 1
'If every 5th color combination is desired then ColStep = 5
Dim RndEndCol As Integer
RndEndCol = StartCol + WorksheetFunction.MRound(EndCol - StartCol, ColStep)
If RndEndCol > 255 Then
EndCol = EndCol - ColStep
'Though this could be EndCol = RndEndCol - ColStep but it returns the same result of final array.
End If

Dim r As Byte, g As Byte, b As Byte, x As Byte, i As Long, j As Byte, k As Byte, l As Long
Dim arr As Variant, arrVal As Variant
x = 2 + (EndCol - StartCol) / ColStep
'ReDim arr(1 To x * 7, 1 To 3)
ReDim arr(1 To x ^ 3, 1 To 3)

StartCol = StartCol - ColStep
'_________________________________________
r = 0: l = 0
For i = 1 To x
    g = 0
    For j = 1 To x
        b = 0
        For k = 1 To x
            l = l + 1
            arr(l, 1) = r
            arr(l, 2) = g
            arr(l, 3) = b
            If b = 0 Then
            b = StartCol + ColStep
            Else
            If b <> 0 And k < x Then b = b + ColStep
            End If
        Next
        If b = 0 Then
        b = StartCol + ColStep
        Else
        If b <> 0 And k < x Then b = b + ColStep
        End If
        If g = 0 Then
        g = StartCol + ColStep
        Else
        If g <> 0 And j < x Then g = g + ColStep
        End If
    Next
    If b = 0 Then
    b = StartCol + ColStep
    Else
    If b <> 0 And k < x Then b = b + ColStep
    End If
    If g = 0 Then
    g = StartCol + ColStep
    Else
    If g <> 0 And j < x Then g = g + ColStep
    End If
    If r = 0 Then
    r = StartCol + ColStep
    Else
    If r <> 0 And i < x Then r = r + ColStep
    End If
Next

If Skip_Black = True Then
    For i = 2 To UBound(arr)
    arr(i - 1, 1) = arr(i, 1): arr(i - 1, 2) = arr(i, 2): arr(i - 1, 3) = arr(i, 3)
    Next i
    arr = Application.Transpose(arr)
    ReDim Preserve arr(1 To UBound(arr, 1), 1 To UBound(arr, 2) - 1)
    arr = Application.Transpose(arr)
End If

RGBColorArray = arr
    
End Function

So, following procedure will color range E1:E125 with different RGB color combinations returned by the above function. Function is RGBColorArray(150, 240, 30). 125 cells is result of 5 step colors (0,150,180,210,240). So, 5*5*5 = 125

Sub ColorMyRange()
Dim cell As Range, arr As Variant, i As Long, x As Long
i = 1
arr = RGBColorArray(150, 240, 30)
x = UBound(arr, 1)

For Each cell In Range("E1:E" & x)
    cell = arr(i, 1) & " | " & arr(i, 2) & " | " & arr(i, 3)
    cell.Interior.Color = RGB(arr(i, 1), arr(i, 2), arr(i, 3))
    i = i + 1
Next

End Sub

Column A, B and C contains array of RGBColorArray function

enter image description here enter image description here

With following function we can calculate ColStep for the RGBColorArray function.

Function Calculate_ColStep(Number_of_Cells As Long, RGB_Start As Byte, RGB_End As Byte)
Calculate_ColStep = (RGB_End - RGB_Start) / ((WorksheetFunction.RoundUp(Application.Power(Number_of_Cells, 1 / 3), 0)) - 2)
End Function

Using this in following procedure, we can color 250 cells with alternate (dark/bright) colors while skipping black color (first element of RGBColorArray, RBG(0,0,0))

Sub ColorMyRangeAltCol()
Dim Number_of_Cells As Long, RGB_Start As Byte, RGB_End As Byte, ColStep As Byte
Dim cell As Range, arr As Variant, i As Long, j As Long, x As Long

Number_of_Cells = 250
RGB_Start = 150
RGB_End = 240

ColStep = Calculate_ColStep(Number_of_Cells, RGB_Start, RGB_End)

arr = RGBColorArray(RGB_Start, RGB_End, ColStep, True)
'True for skipping first combination row of RGBColorArray of black color RGB(0,0,0)
x = UBound(arr, 1)

i = 1: j = 0
For Each cell In Range("E1:E" & x)
    If cell.Row Mod 2 = 0 Then
    cell = arr(x - j, 1) & " | " & arr(x - j, 2) & " | " & arr(x - j, 3)
    cell.Interior.Color = RGB(arr(x - j, 1), arr(x - j, 2), arr(x - j, 3))
    Else
    cell = arr(i, 1) & " | " & arr(i, 2) & " | " & arr(i, 3)
    cell.Interior.Color = RGB(arr(i, 1), arr(i, 2), arr(i, 3))
    End If
    i = i + 1: j = j + 1
    'To color only given number of cells use following condition
    'In the absence of the following condition, x number of cells will be colored
    If i > Number_of_Cells Then Exit For
Next

End Sub

enter image description here enter image description here

Naresh
  • 305
  • 2
  • 13