Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 66
  • Last Modified:

Select a random value from list and chg background color.

I have a sheet tab, Sheet1 and in column A has values in it.  I would like to (no matter how many values are there) press a button on the sheet that selects a random value from that column and pops it up in a Msgbox.  It would highlight that value, so the next time it does a random select it will exclude any that have the background color.  So the background colored cell would accumulate, and eventually all in the list will have a background color.  When I do and clear all background colors it will start over.
0
RWayneH
Asked:
RWayneH
  • 3
  • 2
1 Solution
 
Rgonzo1971Commented:
Hi,

pls try

Sub Macro()
Dim aRows() As Variant
Set myRng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
myRng.AutoFilter Field:=1, Operator:=xlFilterNoFill

If myRng.SpecialCells(xlCellTypeVisible).Cells.CountLarge = 1 Then
    myRng.AutoFilter
    Range("A1").EntireColumn.Interior.Pattern = xlNone
Else
    Set rngSpec = myRng.Offset(1).Resize(myRng.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
    Idx = 0
    For Each c In rngSpec
        ReDim Preserve aRows(Idx)
        aRows(Idx) = c.Row
        Idx = Idx + 1
    Next
    If rngSpec.Cells.Count >= 1 Then
        LngValCnt = rngSpec.Cells.Count
        res = WorksheetFunction.RandBetween(0, UBound(aRows))
        Cells(aRows(res), 1).Interior.Color = 65535

    End If
    myRng.AutoFilter
    MsgBox Cells(aRows(res), 1).Value
End If
End Sub

Open in new window

Regards
EE20161010.xlsm
0
 
RWayneHAuthor Commented:
Working good and thanks.,,,  Does it matter that I do not have a column header a ColA?  If there is an edit required which Ln would need to chg?
0
 
Rgonzo1971Commented:
Since I use Filter it is necessary to have a header
0
 
RWayneHAuthor Commented:
Excellent!!!  Thanks for the help
0
 
Rgonzo1971Commented:
Version without filter (no header)

Sub Macro1()
Dim aRows() As Long
Set myRng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
For Each c In myRng
    If c.Interior.Pattern = xlNone Then
        ReDim Preserve aRows(Idx)
        aRows(Idx) = c.Row
        Idx = Idx + 1
        bInit = True
    End If
Next
If bInit = False Then
    Range("A1").EntireColumn.Interior.Pattern = xlNone
Else
    res = WorksheetFunction.RandBetween(0, UBound(aRows))
    Cells(aRows(res), 1).Interior.Color = 65535
End If
End Sub

Open in new window

0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now