VBA RandCellTest: Random Cell Generator

[Morey]

The VBA Code below works for me but, I would prefer to be able to specify a 10% random selection. Any help would be appreciated.

Function RandCell(Rg As Range) As Range
    Set RandCell = Rg.Cells(Int(Rnd * Rg.Cells.Count) + 1)
End Function

Sub RandCellTest()
Dim Counter As Long
Dim TargetRg As Range, Cell As Range

Set TargetRg = Range("M3:M2000")

TargetRg.ClearFormats

For Counter = 1 To 150
    Set Cell = RandCell(TargetRg)
    Cell.Interior.Color = RGB(0, 255, 0)   'use this if you need one color
'    Cell.Interior.Color = RGB(Int((255 * Rnd)), Int((255 * Rnd)), Int((255 * Rnd)))     'use this if you need random colors
Next

End Sub

Regards,

Morey

 

[Fluff]

Do you mean you want to highlight 10% of the selected range (ie ~200 cells)?
Also are you worried about certain cells being "selected" more than once?

 

[Morey]

Do you mean you want to highlight 10% of the selected range (ie ~200 cells)?
Also are you worried about certain cells being "selected" more than once?

Fluff,

Yes & yes... Also, currently the code re-formats the cells. I would like the cells not to be reformatted.

Regards,

Morey

 

[Fluff]

Ok, how about

Sub RandCellTest()
   Dim Counter As Long
   Dim TargetRg As Range, Cell As Range
   
   Set TargetRg = Range("M3:M2000")
   
   TargetRg.Interior.Color = xlNone
   
   With CreateObject("scripting.dictionary")
      For Counter = 1 To TargetRg.Count / 10
         Set Cell = RandCell(TargetRg)
         Do Until .Exists(Cell.Address) = False
            Set Cell = RandCell(TargetRg)
         Loop
         .Add Cell.Address, Nothing
         Cell.Interior.Color = RGB(0, 255, 0)   'use this if you need one color
      Next Counter
   End With
End Sub

 

[Morey]

Ok, how about

Sub RandCellTest()
   Dim Counter As Long
   Dim TargetRg As Range, Cell As Range
  
   Set TargetRg = Range("M3:M2000")
  
   TargetRg.Interior.Color = xlNone
  
   With CreateObject("scripting.dictionary")
      For Counter = 1 To TargetRg.Count / 10
         Set Cell = RandCell(TargetRg)
         Do Until .Exists(Cell.Address) = False
            Set Cell = RandCell(TargetRg)
         Loop
         .Add Cell.Address, Nothing
         Cell.Interior.Color = RGB(0, 255, 0)   'use this if you need one color
      Next Counter
   End With
End Sub

Fluff,

I'm getting a Compile Error (Sub or Function not defined). Image is attached for reference.


Regards,

Morey

 

[Fluff]

Did you delete this function?

Function RandCell(Rg As Range) As Range
    Set RandCell = Rg.Cells(Int(Rnd * Rg.Cells.Count) + 1)
End Function

 

[Morey]

Did you delete this function?

Function RandCell(Rg As Range) As Range
    Set RandCell = Rg.Cells(Int(Rnd * Rg.Cells.Count) + 1)
End Function

Fluff,

Added that section back in... What do you, know? It works. I could not be more appreciative.


Thank you,

Morey

 

[Fluff]

You're welcome & thanks for the feedback