excelvbatext-coloring

Different Color for Each Cell in a Range


I need some help here, I need my macro to color each cell in a range, but each cell has to have a different color than the cell above. The code that I'm currently using does not perform that differentiation. The code is:

Function intRndColor()
    'USE - FUNCTION TO PICK RANDOM COLOR, ALSO ALLOWS EXCLUSION OF COLORS YOU DON'T LIKE
    Dim Again As Label
    Dim RangeX As Range
    Set RangeX = Range(Range("A1"), Range("A1").End(xlDown))

    Again:
        intRndColor = Int((50 * Rnd) + 1) 'GENERATE RANDOM IN

        Select Case intRndColor
            Case Is = 0, 1, 5, 9, 3, 13, 29, 30, 11, 21, 25, 29, 30, 32, 49, 51, 52, 55, 56 'COLORS YOU DON'T WANT
                GoTo Again
            Case Is = pubPrevColor
                GoTo Again
        End Select

        pubPrevColor = intRndColor 'ASSIGN CURRENT COLOR TO PREV COLOR

        ' Range(Range("A1"), Range("A1").End(xlDown)).Interior.ColorIndex = pubPrevColor

        For Each c In RangeX
            c.Interior.ColorIndex = pubPrevColor
        Next c
End Function

This code makes the whole range to be the same color, I don't get what I'm missing here...


Solution

  • You're picking a random colour correctly (albeit maxing out at 51). You're then just applying that one colour to all of your cells. You need to choose a random colour each time you apply it to a cell.

    If you want to do it without using GoTo etc.

    Dim RangeX As Range, avoidcolours As String, intRndColor As Long, firstcell As Boolean
    avoidcolours = ",0,1,5,9,3,13,29,30,11,21,25,29,30,32,49,51,52,55,56,"
    
    Set RangeX = Range(Range("A1"), Range("A1").End(xlDown))
    firstcell = True
    
    'Cycle through cells
    For Each c In RangeX.Cells
        If firstcell Then
            'Pick random starting colour
            intRndColor = 0
            Do Until InStr(1, avoidcolours, "," & intRndColor & ",") = 0
                intRndColor = Int((50 * Rnd) + 1)
            Loop
            firstcell = False
        Else
            'Pick random colour
            Do Until intRndColor <> c.Offset(-1, 0).Interior.ColorIndex And InStr(1, avoidcolours, "," & intRndColor & ",") = 0
                intRndColor = Int((55 * Rnd) + 1)
            Loop
        End If
        c.Interior.ColorIndex = intRndColor
    Next c
    

    A slightly tidier approach is to create a loop to apply the random colour and a function to generate the number:

    Sub applycolours()
        'USE - APPLYS RANDOM COLOURS TO CELLS, DIFFERING FROM CELL ABOVE
        Dim RangeX As Range, intRndColor As Long, firstcell As Boolean
    
        Set RangeX = Range(Range("A1"), Range("A1").End(xlDown))
        firstcell = True
        'Cycle through cells
        For Each c In RangeX.Cells
            If firstcell Then
                'Pick random starting colour
                intRndColor = randomcolour
                firstcell = False
            Else
                'Pick random colour
                Do Until intRndColor <> c.Offset(-1, 0).Interior.ColorIndex
                    intRndColor = randomcolour
                Loop
            End If
            c.Interior.ColorIndex = intRndColor
        Next c
    End Sub
    
    Function randomcolour() as long
        'USE - FUNCTION TO PICK RANDOM COLOR, ALSO ALLOWS EXCLUSION OF COLORS YOU DON'T LIKE
        Dim avoidcolours as String
        avoidcolours = ",0,1,5,9,3,13,29,30,11,21,25,29,30,32,49,51,52,55,56,"
        randomcolour = 0
        Do Until InStr(1, avoidcolours, "," & randomcolour & ",") = 0
            randomcolour = Int((55 * Rnd) + 1)
        Loop
    End Function