VBA code to select & highlight x no. of rows randomly based on the categories in column

[linspiredgal]

Hi

I need random record to be selected from a group of categories in column.

Eg- from the table below- I need two names randomly highlighted, from each city type.
i.e two randomly selected names from NYC, seattle, toronto and california each.

Name	Class	city
ABC	1	NYC
DEF	2	NYC
GHI	2	Seattle
JKL	2	Seattle
MNO	3	Toronto
PQR	3	Toronto
STU	4	Toronto
VWX	5	NYC
YZ	5	California
BVB	2	Toronto
GHG	2	Toronto
GDCK	3	NYC
HGHG	3	NYC
DFDF	5	California
DCBJ	5	California

<tbody>
</tbody>

 

[MickG]

Re: I need VBA code to select & highlight x no. of rows randomly based on the categories in column

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG18Jun18
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("C2", Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Dn.Address
    [COLOR="Navy"]Else[/COLOR]
        .Item(Dn.Value) = .Item(Dn.Value) & "," & Dn.Address
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, Rd [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nRd [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    Sp = Split(.Item(K), ",")
    Rd = Application.RandBetween(0, UBound(Sp))
    nRd = Rd
     [COLOR="Navy"]Do[/COLOR] Until nRd <> Rd
        nRd = Application.RandBetween(0, UBound(Sp))
     [COLOR="Navy"]Loop[/COLOR]
     Range(Sp(Rd)).EntireRow.Interior.Color = vbYellow
     Range(Sp(nRd)).EntireRow.Interior.Color = vbYellow
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[linspiredgal]

Re: I need VBA code to select & highlight x no. of rows randomly based on the categories in column

Thanks a lot Mick.
It works perfect.

Could you also tell me where do I need to make change if I need more or less then 2 records from each city to be selected?

Regards

 

[MickG]

Re: I need VBA code to select & highlight x no. of rows randomly based on the categories in column

Try this:-
NB:- When you run the code , You will be asked for a number, this is the number of rows to Highlight for any given state/city, if the number entered is Greater than the count of any individual state then all entries for that that state/city will all be highlighted.

[COLOR="Navy"]Sub[/COLOR] MG18Jun12
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("C2", Range("C" & Rows.Count).End(xlUp))
Num = InputBox("Enter number", "Number", "Enter your number here")
[COLOR="Navy"]If[/COLOR] Num < 1 Or Not IsNumeric(Num) [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Dn.Address
    [COLOR="Navy"]Else[/COLOR]
        .Item(Dn.Value) = .Item(Dn.Value) & "," & Dn.Address
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]


[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, Rd [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] SpA [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    Sp = Split(.Item(K), ",")
    [COLOR="Navy"]If[/COLOR] Num >= UBound(Sp) + 1 [COLOR="Navy"]Then[/COLOR]
        Range(.Item(K)).EntireRow.Interior.Color = vbYellow
    [COLOR="Navy"]Else[/COLOR]
        Do
            Rd = Application.RandBetween(0, UBound(Sp))
            [COLOR="Navy"]If[/COLOR] InStr(nStr, Rd) = 0 [COLOR="Navy"]Then[/COLOR]
               nStr = nStr & IIf(nStr = "", Rd, "," & Rd)
            [COLOR="Navy"]End[/COLOR] If
        Loop Until UBound(Split(nStr, ",")) + 1 = Num
     
        SpA = Split(nStr, ",")
        [COLOR="Navy"]For[/COLOR] n = 0 To UBound(SpA)
            Range(Sp(SpA(n))).EntireRow.Interior.Color = vbYellow
        [COLOR="Navy"]Next[/COLOR] n
            nStr = ""
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[linspiredgal]

Re: I need VBA code to select & highlight x no. of rows randomly based on the categories in column

Thanks Mick.
It works..

 

[MickG]

Re: I need VBA code to select & highlight x no. of rows randomly based on the categories in column

You're welcome