• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Having fun with loops

simmonds

New Member
Hello! I'm totally new to excel and have been having some fun trying to do some basic tasks.

I wanted to get used to loops so I tried to make some interesting situations using loops and gradients. I started with a 50 by 50 range made into small squares and made various codes to make random, colourful squares or simple linear gradients.

I was trying out some diagonal gradients but couldn't get a single, smooth gradient from corner to corner until earlier this morning.

The code is probably disgusting to all you Excel wizards and I have defintely dimmed some unnecessary variables (Looper, endnum and i could probably do with fewer num's).

What interesting pictures can you guys paint using simple loops?

Code:
Sub colourmesilly()

Dim r As Long
Dim g As Long
Dim b As Long
Dim num As Long
Dim endnum As Long
Dim looper As Long
Dim ender As Variant
Dim num2 As Long
Dim num3 As Long

'This code will create a diagonal gradient in a (nearly) random colour

'Random number generator for new colours each time
'It must be 201 to prevent the colour from running over
'although there are boundaries in place to prevent errors
'if this does happen
r = Int((201 - 1 + 1) * Rnd + 2)
g = Int((201 - 1 + 1) * Rnd + 2)
b = Int((201 - 1 + 1) * Rnd + 2)

endnum = 53

'Initial loop to colour first half
For num = 52 To endnum

     'Colour changer
            r = r + 1
                If r > 255 Then
                 r = 1
                End If
            g = g + 1
                If g > 255 Then
                g = 1
                End If

            b = b + 1
                If b > 255 Then
                b = 1
                End If

        'initial num to calculate sequence
        num = num - 2
        num3 = 0

    'End loop to find when loop reaches midway
         If num = 1 Then
        GoTo secondhalf:
         Else
         End If

    'Loop to get back to 50
        For num2 = num To 50
        num3 = num3 + 1
       
    'colour the range
    Cells(num3, num2).Interior.Color = RGB(r, g, b)

          'ender = MsgBox((num2) & " " & (num3), vbOKCancel)
               'If ender = vbCancel Then
               'GoTo finish:
              'End If
             
          Next num2
   
Next num

'Colours second half in accordance to first half
secondhalf:

For num = 1 To 50
'This must be zero to account for middle ground, first half actually does one cell less
num3 = 0

        'Colour changer
            r = r + 1
                If r > 255 Then
                 r = 1
                End If
            g = g + 1
                If g > 255 Then
                g = 1
                End If

            b = b + 1
                If b > 255 Then
                b = 1
                End If

'Simple sequence that calculates 1 - x+1 where num3 is x

    For num2 = num To 50
    num3 = num3 + 1
   
    Cells(num2, num3).Interior.Color = RGB(r, g, b)

 'ender = MsgBox((num3) & " " & (num2), vbOKCancel)
                'If ender = vbCancel Then
                'GoTo finish:
                'End If
               
    Next num2

Next num

finish:


End Sub
 
Back
Top