CODEWITHSUNDEEP
vbaexcel
HotSauceCoconuts
HotSauceCoconuts

Reputation: 321

Random colour changing with cell Interior.Color

I cobbled something simple together to see what would happen, and of course I broke excel.

Sub colourChange()

    Dim r As Byte, g As Byte, b As Byte

    On Error Resume Next

    For l = 0 To 50
        For j = 1 To 22
            For k = 1 To 66
                r = WorksheetFunction.RandBetween(0, 255)
                g = WorksheetFunction.RandBetween(0, 255)
                b = WorksheetFunction.RandBetween(0, 255)
                Cells(j, k).Interior.Color = RGB(r, g, b)
            Next k
        Next j
        Application.Wait Now + #12:00:03 AM#
    Next l

End Sub

It starts well, and then beings to slow down to a virtual standstill, eventually even producing the Too many different cell formats error.

Is there any way I can speed it up and stop the errors? I looked it up, excel is supposed to support 4000 different cell formats, and I shouldn't be hitting even half of that! Is it remembering the previous ones or something? What's going on here?

Upvotes: 3

Views: 8968

Answers (2)

Dy.Lee
Dy.Lee

Reputation: 7567

I think for l= 0 to 50 not needed. And Application.ScreenUpdating = False setting is help to practice faster. And I guess Excel has a limit of total number of interior colors.

Sub colourChange()

    Dim r As Byte, g As Byte, b As Byte
    Dim vR(), n As Integer
    'Cells.Clear
    n = 3000
    ReDim vR(1 To n)
    For i = 1 To n
        r = WorksheetFunction.RandBetween(0, 255)
        g = WorksheetFunction.RandBetween(0, 255)
        b = WorksheetFunction.RandBetween(0, 255)
        vR(i) = RGB(r, g, b)
    Next i
    Application.ScreenUpdating = False
        For j = 1 To 500
            For k = 1 To 100
                Cells(j, k).Interior.Color = vR(WorksheetFunction.RandBetween(1, n))

            Next k
        Next j
    Application.ScreenUpdating = True
End Sub

Other way, first practice sub getColor()(first one time only) and then practice colourchang() .

Public vR()
Public n As Integer
Sub getColor()
    Dim r As Byte, g As Byte, b As Byte
    Dim i As Integer
    'Cells.Clear
    n = 3000
    ReDim vR(1 To n)
    For i = 1 To n
        r = WorksheetFunction.RandBetween(0, 255)
        g = WorksheetFunction.RandBetween(0, 255)
        b = WorksheetFunction.RandBetween(0, 255)
        vR(i) = RGB(r, g, b)
    Next i

End Sub
Sub colourChange()
    Dim j As Integer, k As Integer, m As Integer
    Application.ScreenUpdating = False
        For j = 1 To 500
            For k = 1 To 100
                m = WorksheetFunction.RandBetween(1, n)
                Cells(j, k).Interior.Color = vR(m)
            Next k
        Next j
    Application.ScreenUpdating = True
End Sub

Upvotes: 2

Michał Turczyn
Michał Turczyn

Reputation: 37377

It works well for me. Be aware of that you are using Wait function, which causes 3 seconds delay of every "frame" :) The way to speed it up is to reduce the delay from 3 seconds to 1 second :)

But then the colors won't be changing that much, since random numbers generator is based on system time, and it will change less if we reduce the delay.

You could also use function Rnd() and multiply it by 256 instead of using worksheet function. But I am not sure, that it will affect the duration of the execution significantly.

Upvotes: 1

Related Questions