Skip to main content
3 of 13
edited title
Mast
  • 13.8k
  • 12
  • 57
  • 127

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) 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

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

Naresh
  • 305
  • 2
  • 13