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.

[TABLE="width: 192"]
<tbody>[TR]
[TD="class: xl65, width: 64"]Name[/TD]
[TD="class: xl65, width: 64"]Class[/TD]
[TD="class: xl65, width: 64"]city[/TD]
[/TR]
[TR]
[TD="class: xl63"]ABC[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl63"]NYC[/TD]
[/TR]
[TR]
[TD="class: xl63"]DEF[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl63"]NYC[/TD]
[/TR]
[TR]
[TD="class: xl63"]GHI[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl63"]Seattle[/TD]
[/TR]
[TR]
[TD="class: xl63"]JKL[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl63"]Seattle[/TD]
[/TR]
[TR]
[TD="class: xl63"]MNO[/TD]
[TD="class: xl64"]3[/TD]
[TD="class: xl63"]Toronto[/TD]
[/TR]
[TR]
[TD="class: xl63"]PQR[/TD]
[TD="class: xl64"]3[/TD]
[TD="class: xl63"]Toronto[/TD]
[/TR]
[TR]
[TD="class: xl63"]STU[/TD]
[TD="class: xl64"]4[/TD]
[TD="class: xl63"]Toronto[/TD]
[/TR]
[TR]
[TD="class: xl63"]VWX[/TD]
[TD="class: xl64"]5[/TD]
[TD="class: xl63"]NYC[/TD]
[/TR]
[TR]
[TD="class: xl63"]YZ[/TD]
[TD="class: xl64"]5[/TD]
[TD="class: xl63"]California[/TD]
[/TR]
[TR]
[TD="class: xl63"]BVB[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl63"]Toronto[/TD]
[/TR]
[TR]
[TD="class: xl63"]GHG[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl63"]Toronto[/TD]
[/TR]
[TR]
[TD="class: xl63"]GDCK[/TD]
[TD="class: xl64"]3[/TD]
[TD="class: xl63"]NYC[/TD]
[/TR]
[TR]
[TD="class: xl63"]HGHG[/TD]
[TD="class: xl64"]3[/TD]
[TD="class: xl63"]NYC[/TD]
[/TR]
[TR]
[TD="class: xl63"]DFDF[/TD]
[TD="class: xl64"]5[/TD]
[TD="class: xl63"]California[/TD]
[/TR]
[TR]
[TD="class: xl63"]DCBJ[/TD]
[TD="class: xl64"]5[/TD]
[TD="class: xl63"]California[/TD]
[/TR]
</tbody>[/TABLE]

 

[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