Solved

Select a random value from list and chg background color.

Posted on 2016-10-10
5
40 Views
Last Modified: 2016-10-10
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
Comment
Question by:RWayneH
  • 3
  • 2
5 Comments
 
LVL 49

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 41836843
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
 

Author Comment

by:RWayneH
ID: 41836886
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
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 41836916
Since I use Filter it is necessary to have a header
0
 

Author Closing Comment

by:RWayneH
ID: 41836930
Excellent!!!  Thanks for the help
0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 41836960
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Not sure what the best email signature size is? Are you worried about email signature image size? Follow this best practice guide.
This article explains how to prepare an HTML email signature template file containing dynamic placeholders for users' Azure AD data. Furthermore, it explains how to use this file to remotely set up a department-wide email signature policy in Office …
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now