loop through cells and color interior randomisation

james potter

New Member
Joined
Aug 15, 2005
Messages
45
Hello,

I have created a vba-macro that runs through a certain range. It compairs the value of the above cell with the current cell. If it is the same then it will give the cell the same color, so not then it will give a random color. I have tested it in one sheet and works fine, but to do it for all sheets in the workbook it jams. The range starts in every sheet in the same cell, d5.

How can I make the code so it will loop through all sheets from cell d4 and give the cell a random color if the compairing fails?

Code:
Sub looping()

Dim noSheets
Dim x

noSheets = ActiveWorkbook.Worksheets.Count
For x = 1 To noSheets
ActiveCell = Worksheets(x).Range("d5")

    Do
    If Worksheets(x).ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
    Selection.Interior.ColorIndex = ActiveCell.Offset(-1, 0).Interior.ColorIndex
    Else
    Selection.Interior.ColorIndex = (random color)
    End If
    ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell)

Next x

End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Boller

Banned
Joined
Apr 11, 2006
Messages
2,328
Within your loop you have to preface each cell reference with the workbook reference.

Also, you can only Select a cell on the active worksheet.
 

james potter

New Member
Joined
Aug 15, 2005
Messages
45
othe approach

Hello,

I have made some adjustments to the code but I have still some problems with it. Maybe someone can help me?

How can I randomize the colorindex number?
I have tried it with for ... next argument but that keeps running until the last number. With no use of for ... next argument if works fine but cell color and indexnumber stays the same.
 

james potter

New Member
Joined
Aug 15, 2005
Messages
45
forgot the code

Code:
Sub looping2()

Range("a2").Select

    Do
    If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
    Selection.Interior.ColorIndex = ActiveCell.Offset(-1, 0).Interior.ColorIndex
    Else
    Selection.Interior.ColorIndex = 13
    End If
    ActiveCell.Offset(1, 0).Select
    Loop Until IsEmpty(ActiveCell)

End Sub
 

Boller

Banned
Joined
Apr 11, 2006
Messages
2,328
Code:
Sub looping()
Dim noSheets%, x%, rng As Range, cell As Range
noSheets = ActiveWorkbook.Worksheets.Count
For x = 1 To noSheets
    With Worksheets(x)
        Set rng = .Range(.[A2], .[A65536].End(xlUp))
    End With
    For Each cell In rng
        If cell = cell(0) Then
            cell.Interior.ColorIndex = cell(0).Interior.ColorIndex
        Else
            cell.Interior.ColorIndex = Int(54 * Rnd + 1)
        End If
    Next cell
Next x
End Sub
 

Forum statistics

Threads
1,137,335
Messages
5,680,887
Members
419,937
Latest member
Talic

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top