Set random cells containing numbers in spreadsheet red. Then add the red cells only.

chamblessw

New member
Joined
Mar 10, 2013
Messages
7
Reaction score
0
Points
0
Set random cells containing numbers in spreadsheet red. Then add the red cells only.
 
I think this will do what you want
Code:
Sub test()
    Dim myCells As Range, oneCell As Range
    Dim RedPercentage As Double
    Dim SumOfRed As Double
    
    RedPercentage = 0.5: Rem adjust
    
    On Error Resume Next
        Set myCells = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
        Set myCells = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, xlNumbers)
        Set myCells = Application.Union(myCells, ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlNumbers))
    On Error GoTo 0
    
    Randomize
    For Each oneCell In myCells
        If Rnd() < RedPercentage Then
            oneCell.Interior.Color = vbRed
            SumOfRed = SumOfRed + oneCell.Value
        Else
            oneCell.Interior.ColorIndex = xlNone
        End If
    Next oneCell
    
    MsgBox "The sum of the red cells is " & SumOfRed
End Sub
 
As a kind of curiosity.. What is the purpose of such request?
 
Back
Top