VBA: how to randomize listbox items?

Kimberley

New Member
Joined
Nov 27, 2011
Messages
22
Hi,

I'm looking for a way to randomize listbox items after pressing a button. The listbox has 3 columns : 1/ entries number 2/ male name 3/ female name. Columns 2 and 3 always come together, so when one item moves up or down, the other is moving along.

Example:

Code:
01   Todd	Britney
02   Jimi	Meredith
03   Serge	Amy
04   Richard	Kim
05   Roger	Gabrielle
06   Mike	Tammy
07   Bill	Jill
08   Jim	Joyce
09   Phil	Judy
10   Bebel	Jules
11   Fredrik	Helen
12   James	Yolanda

After pressing the Randomize button we should get something like this:

Code:
01   Serge	Amy
02   Jim	Joyce
03   Fredrik	Helen
04   Mike	Tammy
05   Jimi	Meredith
06   Bill	Jill
07   Roger	Gabrielle
08   Phil	Judy
09   Richard	Kim
10   James	Yolanda
11   Todd	Britney
12   Bebel	Jules

Todd and Britney randomly moved from the 1st position to the 11th but they're still together. Same thing for the other couples.

The xlsm can be downloaded there:

UserForm.xlsm - 0.03MB

Thanks in advance!
 

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,805
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows
Hi, try this:
Rich (BB code):

' Code for "Randomize" button
Private Sub CommandButton1_Click()
  With ListBox1
    .List = RandomSort(.List, 0, 1)
  End With
End Sub

' ZVI:2011-11-29 http://www.mrexcel.com/forum/showthread.php?t=595216
' Random Sorting of List2D array
' Optional [EnumCol] defines the enumeration column number
' Optional [EnumAdder = 1] is useful for enumeration of list items starting from #1
Function RandomSort(List2D, Optional EnumCol, Optional EnumAdder = 1)
  
  Dim a(), b&(), i&, j&, lb1&, lb2&, ub1&, ub2&, v#
  
  lb1 = LBound(List2D, 1)
  ub1 = UBound(List2D, 1)
  lb2 = LBound(List2D, 2)
  ub2 = UBound(List2D, 2)
  ReDim a(lb1 To ub1)
  ReDim b(lb1 To ub1)
  
  ' Populate a() with random double numbers with less than zero values
  Randomize
  For i = lb1 To ub1
    a(i) = Rnd - 1
  Next
  
  ' Rank a() and put it (that is, random row order) in b()
  For i = lb1 To ub1
    v = 0
    For j = lb1 To ub1
      If a(j) < v Then
        v = a(j)
        b(i) = j
      End If
    Next
    a(b(i)) = 0
  Next
  
  ' Create new output array a()
  ReDim a(lb1 To ub1, lb2 To ub2)
  
  ' Copy from List2D to a() in order of b() values
  For i = lb1 To ub1
    For j = lb2 To ub2
      a(i, j) = List2D(b(i), j)
    Next
    If Not IsMissing(EnumCol) Then a(i, EnumCol) = i + EnumAdder
  Next
  
  ' Return a()
  RandomSort = a()
  
End Function
 
Last edited:

Kimberley

New Member
Joined
Nov 27, 2011
Messages
22
Thanks Vladimir, it's working perfectly! And that's fortunate because I can't even read/understand the RandomSort function.
 

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,805
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows
My pleasure, Kimberley - it’s good if it works for you!

Comparing with formula solution may shed the light on algorithm.

The code of the 1st commented part populate a() array by random numbers like the formulas in D-column in the example shown below.

The code of the 2nd commented part provides ranking of random numbers with the similar result in b() array as in returned result of the single array formula of D2:D20 range.

For formula solution range B2:E20 should be sorted by E-column.
But for VBA we do the same by copying of initial list into new empty array a() row by row in the order of b() array values.
That new a() array returns as the result of the function.
Simple enough, isn’t it? :)
Excel Workbook
ABCDE
1EnumColMalesFemalesPopulate a() by RndRank a() and put it in b()
21ToddBritney0.6334981878
32JimiMeredith0.26749870516
43SergeAmy0.8635222723
54RichardKim0.41818243512
65RogerGabrielle0.995051311
76MikeTammy0.6944026327
87BillJill0.7327742085
98JimJoyce0.9891220822
109PhilJudy0.51730632310
1110BebelJules0.8410335144
1211FredrikHelen0.05878464919
1312JamesYolanda0.29961860815
1413KirkTania0.14895126417
1514RobertCynthia0.06431147818
1615LarsLiv0.49204758111
1716FredBeth0.5494459859
1817WesLiz0.36306013114
1918JohnBibi0.7006916696
2019SamLauren0.37474389213
Sheet


Regards
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,123,402
Messages
5,601,475
Members
414,452
Latest member
Dannysamworth

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top