loop through cells and color interior randomisation

[james potter]

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?

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

 

[Boller]

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]

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]

forgot the 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]

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

 

[james potter]

Thanks you all for your efforts. It is working now