Related
Lets say I have a database of words in Sheet2; it goes from A1 to B200.
I need to randomly select one of those words; and show it in Sheet1.
Moreover, I need to have on blank cell between each letter of the word.
Example: The randomly selected word is COLD; it has to appear like this:
A1: C
A3: O
A5: L
A7: D
How can I code this?
try this code:
Option Explicit
Sub main()
Dim word As String
word = GetRandomWord(Worksheets("Sheet2").Range("A1:B200")) '<--| get content of a random cell in passed range
Worksheets("Sheet1").Range("a1").Resize(2 * Len(word) - 1).Value = Application.Transpose(SeparatedChars(word)) '<--| write it down from given worksheet cell A1 down skipping every two cells
End Sub
Function SeparatedChars(strng As String) As Variant
Dim i As Long
ReDim chars(0 To Len(strng) - 1) As String '<--| size a 'String' array to the length of passed word
For i = 1 To Len(strng)
chars(i - 1) = Mid$(strng, i, 1) '<--| fill array elements with word single characters
Next
SeparatedChars = Split(Join(chars, " "), " ") '<--| return an array whose elements are those of the 'String' array and interposed spaces
End Function
Function GetRandomWord(rng As Range) As String
Randomize
GetRandomWord = rng.Cells(Int((rng.Count) * Rnd() + 1)).Text
End Function
Assuming the words are written in column A of sheet2 you could do the following (part of this solution comes from here:
Sub randomWord()
Dim rndWordRow As Integer
Dim arr() As String
Dim buff() As String
'Select row between 1 and 200 randomly'
rndWordRow = Int((200 - 1 + 1) * Rnd + 1)
'Write text of the randomly selected row into variable'
rndWord = Sheets("Sheet2").Cells(rndWordRow, 1)
'Write letters of text into array'
ReDim buff(Len(rndWord) - 1)
For i = 1 To Len(rndWord)
buff(i - 1) = Mid$(rndWord, i, 1)
Next
'Loop through array and write letters in single cells'
For i = 0 To UBound(buff)
Sheets("Sheet1").Cells(i + 1, 1) = buff(i)
Next i
End Sub
Sub Test()
Dim x As Long
Dim aWord
With Worksheets("Sheet1")
For x = 1 To 15
aWord = getRandomWord
.Cells(1, x).Resize(UBound(aWord)).value = aWord
Next
End With
End Sub
Function getRandomWord()
Dim Source As Range
Dim result
Dim i As Integer
Set Source = Worksheets("Sheet2").Range("A1:B200")
i = Int((Rnd * Source.Cells.Count) + 1)
result = StrConv(Source.Cells(i).Text, vbUnicode)
result = Split(Left(result, Len(result) - 1), vbNullChar)
getRandomWord = Application.Transpose(result)
End Function
Here's a simple solution to your problem. This routine gives you a blank cell between two letters with the first letter in the first cell.
R1 = Int(Rnd() * 200)
R2 = Int(Rnd() * 2)
anyword = Sheet2.Cells(R1, R2)
x = Len(anyword)
n = -1: i = 1
Do
n = n + 2
Sheet1.Cells(n, 1) = Mid(anyword, i, 1)
i = i + 1
Loop Until n > x * 2
Say, my original data block is worksheets(1).range("A1:C100"), and I'd like to stack the columns of this block into a single column, that is, I first put first column, then the second column goes below, and finally the third column. In the end, I should have a single column, say being put in worksheets(2).range("A1:A300"). I wonder if there's any smart and fast algorithm to achieve this?
Without VBA, In Sheet2 cell A1 enter:
=OFFSET(Sheet1!$A$1,MOD(ROWS($1:1)-1,100),ROUNDUP(ROWS($1:1)/100,0)-1,)
and copy down.
and with VBA
Sub copy_table_to_column()
Dim s As String
s = "=OFFSET(Sheet1!$A$1,MOD(ROWS($1:1)-1,100),ROUNDUP(ROWS($1:1)/100,0)-1,)"
With Worksheets("Sheet2").Range("A1:A300")
.Formula = s
.Value = .Value
End With
End Sub
There might be a better way, but I usually do it with an Offset
I=0
For Each A in Worksheets(1).Range("A1:A100").Cells
Worksheets(2).Range("A1").Offset(I,0) = A.Value
I = I + 1
Next
For Each B in Worksheets(1).Range("B1:B100").Cells
Worksheets(2).Range("A1").Offset(I,0) = B.Value
I = I + 1
Next
For Each C in Worksheets(1).Range("C1:C100").Cells
Worksheets(2).Range("A1").Offset(I,0) = C.Value
I = I + 1
Next
This might be good enough for you...
Hope it helps.
Option Explicit
'Define the test function...
Sub test()
Dim vData As Variant
Dim r As Range
Set r = Sheet1.Range("A1:C100")
vData = ConcatinateColumns(r)
End Sub
'Define the function to concatinate columns.
Public Function ConcatinateColumns(ByVal Data As Range)
Dim vTemp As Variant
Dim i As Integer, j As Long, k As Long
'Get the data for each cell to a variant.
vTemp = Data.Value
ReDim vData(1 To (UBound(vTemp, 1) - LBound(vTemp, 1) + 1) * (UBound(vTemp, 2) - LBound(vTemp, 2) + 1), 1 To 1) As Variant
For i = LBound(vTemp, 2) To UBound(vTemp, 2)
For j = LBound(vTemp, 1) To UBound(vTemp, 1)
k = k + 1
vData(k, LBound(vData, 1)) = vTemp(j, i)
Next
Next
ConcatinateColumns = vData
End Function
I am receiving a run-time error, but that may be the least of my problems. The logic makes sense in my head but I may not be using the correct syntax or functions. My code is below with comments and "hopes":
Sub Random_Points()
Dim i As Integer
Dim j As Integer
Dim Max As Integer
Dim RandomNumber As Integer
Max = 100 '(Max is being multiplied by the Rnd function to provide a random number between 0-100)
For i = 2 To 100 Step 1
RandomNumber = Int(Rnd * Max)
ThisWorkbook.Sheets("VBA").Cells(i, 2).Value = RandomNumber
'(The for loop above with start assigned cells values starting with Cells(2,2) to Cells(100,2))
'(I DO NOT WANT DUPLICATE VALUES...therefore after the value is assigned above I want the code to compare the newly assigned cell to all the cells above it.)
For j = 1 To 98 Step 1
'(...and IF the cell values are the same...)
If ThisWorkbook.Sheets("VBA").Cells(i, 2).Value = ThisWorkbook.Sheets("VBA").Cells(i - j, 2).Value Then
'(...A new random number will be assigned...)
RandomNumber = Int(Rnd * Max)
ThisWorkbook.Sheets("VBA").Cells(i, 2).Value = RandomNumber
End If
'(...and then re-checked vs all the others)
Next j
'(Next cell is assigned...loop restarts)
Next i
End Sub
Your problem is in your nested loop. As j increments, it approaches and finally equals i. Subsequently, when you use the two values in .Cells(i - j, 2).Value, there is no Range.Cells property with a row number less than 1.
The solution is to change your nested For ... Next statement so that j never reaches i.
'was ...
For j = 1 To 98 Step 1
'should be ...
For j = 1 To (i - 1) Step 1
You only need to check the values up to i in any event.
fwiw, a WorksheetFunction object's use of MATCH function and VBA's IsError function would be faster.
Sub randomPoints_part_deux()
Dim i As Long, mx As Long, randNum As Long
mx = 100 '(mx is being multiplied by the Rnd function to provide a random number between 0-100)
With ThisWorkbook.Sheets("VBA")
'seed the column of numbers so you have something to check against
randNum = Int(Rnd * mx)
.Cells(2, 2) = randNum
For i = 3 To 100 Step 1
Do While Not IsError(Application.Match(randNum, .Range(.Cells(2, 2), .Cells(i - 1, 2)), 0))
randNum = Int(Rnd * mx)
Loop
.Cells(i, 2) = randNum
Next i
'optional formula to count unique in C2
.Cells(2, 3).Formula = "=SUMPRODUCT(1/COUNTIF(B2:B100, B2:B100))"
End With
End Sub
since you don't want duplicates you can either generate random numbers and then repeatedly check if they are already used or you can generate your list first and then pull from it randomly. The second option is easier.
Sub Random100()
Dim i As Integer
Dim j As Integer
Dim Max As Integer
Dim RandomNumber As Integer
Dim cNum As New Collection
Max = 100 '(Max is being multiplied by the Rnd function to provide a random number between 0-100)
For i = 0 To Max 'fill collection with 0-100 in order
cNum.Add i
Next i
k = cNum.Count - 1
For j = 0 To k
RandomNumber = Int(Rnd * (k - j)) + 1
ThisWorkbook.Sheets("VBA").Cells(j + 2, 2).Value = cNum(RandomNumber)
cNum.Remove (RandomNumber)
Next j
End Sub
If your purpose is to get a range of unique values, then a better approach would be to shuffle a serie:
Const MIN = 1
Const MAX = 98
Dim values(MIN To MAX, 0 To 0) As Double, i&, irand&
' generate all the values
For i = MIN To MAX
values(i, 0) = i
Next
' shuffle the values
For i = MIN To MAX
irand = MIN + Math.Round(Rnd * (MAX - MIN))
value = values(i, 0)
values(i, 0) = values(irand, 0)
values(irand, 0) = value
Next
' copy the values to the sheet
ThisWorkbook.Sheets("VBA").Range("A2").Resize(MAX - MIN + 1, 1) = values
This question already has answers here:
Unique Random Numbers using VBA
(3 answers)
Closed 6 years ago.
I have been working on this project for a while, and have had various help throughout (haven't touched code in a number of years)
I'm creating a lottery ticket generator, and I'm finally almost finished, but my random needs some work, and I'd like to display the numbers in ascending order with separated by hyphen, as the following example without the parenthesis: "12-16-24"
Currently my code puts a different random number (1-24) across three columns in a row and repeats until the loop is complete. The code should minimize the columns to 1 "lottery" column instead of three.
Any idea, how I could go about doing this? My current code to follow:
Sub New_Entry()
Dim strPlayer As String, strTick As Integer, i As Integer, j As Integer
strPlayer = InputBox("Input Player Name")
strTick = InputBox("How many tickets?")
i = Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = i To i + strTick - 1
Cells(i, 1).Value = strPlayer
For j = 2 To 4
Cells(i, j).Value = Int((24 - 1 + 1) * Rnd + 1)
Next j
Next i
End Sub
The following might help you:
Function LotteryTicket() As String
Dim i As Long
Dim nums(1 To 3) As Integer
Dim A(1 To 3) As Variant
With Application.WorksheetFunction
Do While True
For i = 1 To 3
nums(i) = .RandBetween(1, 24)
Next i
For i = 1 To 3
A(i) = .Small(nums, i)
Next i
If A(1) <> A(2) And A(2) <> A(3) Then
LotteryTicket = Join(A, "-")
Exit Function
End If
Loop
End With
End Function
It uses a simple hit-and-miss approach to get distinct numbers. The probability that 3 randomly chosen numbers in 1-24 are distinct is P(24,3)/24^3 = 87.8% so the expected number of runs through the outer loop is less than 2.
Tested like this:
Sub test()
Dim i As Long
For i = 1 To 10
Cells(I,1).Value = LotteryTicket()
Next i
End Sub
After running this the output looks like (assuming that the cells are formatted as text so Excel doesn't interpret things as dates):
1-7-10
1-17-23
8-14-15
8-12-24
2-14-17
4-7-14
5-6-23
16-20-21
4-10-24
6-11-15
If you do not want repeats just test if the numbers are already in the array, if true, then calculate a new random number (this code is written for 6 winning numbers):
Sub New_Entry()
Dim strPlayer As String, strTick As Integer, i As Integer, j As Integer
Dim win_tkt As Variant
Dim number_to_find As Integer
strPlayer = InputBox("Input Player Name")
strTick = InputBox("How many tickets?")
ReDim win_tkt(5) 'how many numbers are extracted -1
i = Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = i To i + strTick - 1
Cells(i, 1).Value = strPlayer
win_tkt(0) = Int((24 - 1 + 1) * Rnd + 1)
For j = 2 To 6 'from 2nd winning number to last winning number
number_to_find = Int((24 - 1 + 1) * Rnd + 1)
Do While IsInArray(number_to_find, win_tkt) = True
number_to_find = Int((24 - 1 + 1) * Rnd + 1)
Loop
win_tkt(j - 1) = number_to_find
Next j
Call sort_array(win_tkt)
Cells(i, 2).Value = Join(win_tkt, "-")
Next i
End Sub
Function IsInArray(find_number As Integer, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, find_number)) > -1)
End Function
Sub sort_array(arr As Variant)
Dim strTemp As String
Dim i As Long
Dim j As Long
Dim lngMin As Long
Dim lngMax As Long
lngMin = LBound(arr)
lngMax = UBound(arr)
For i = lngMin To lngMax - 1
For j = i + 1 To lngMax
If arr(i) > arr(j) Then
strTemp = arr(i)
arr(i) = arr(j)
arr(j) = strTemp
End If
Next j
Next i
End Sub
This question already has answers here:
Repeating random variables in VBA
(2 answers)
Closed 7 years ago.
What would be the VBA code in excel to generate ONE random number between 1 to 100 that is displayed in a given cell (say A1) upon clicking a button, and then when the button is clicked again, it generates another random number between 1 to 100, THAT IS NOT A REPETITION. Ideally, this should allow me to click the button a 100 times and get all the numbers between 1-100 exactly once each ?
Technically there is no such thing as random numbers with no repetition. What you are asking for is actually a random permutation of a set of values, like the ordering of a shuffled deck of cards or lottery ball picks. Random permutation of a range of vlaues can be achieved in Excel VBA succinctly.
Assign your button's macro to RangeValue():
Public Sub RangeValue()
Dim i As Long
Static n As Long, s As String
Const MIN = 1, MAX = 100, OUT = "A1", DEL = "."
Randomize
Do
i = Rnd * (MAX - MIN) + MIN
If 0 = InStr(s, i & DEL) Then
n = n + 1: s = s & i & DEL
Range(OUT) = i
If n > MAX - MIN Then n = 0: s = ""
Exit Do
End If: DoEvents
Loop
End Sub
That's it. The above code is all that is required to answer your question as posed.
You can use the Const line near the top to edit the MIN and MAX range of values that will be spun through randomly. You can also adjust the OUTput cell.
Once all of the values have been output (i.e. 100 button clicks), the code resets and spins through the range again in a new, random order. This continues forever. You can disable multiple spins-through by deleting this line: If n > MAX - MIN Then n = 0: s = ""
How does this work?
The routine maintains a string of previously output values. Each time the procedure is run, it selects a new random value from the range and checks if that value is already logged in the string. If it is it picks a new value and looks again. This continues in a loop until a value not currently logged in the string is randomly selected; that value is logged and output to the cell.
EDIT #1
To address your new question about how to set this up so that it works in more than one cell with different value ranges, assign your button's macro to ButtonClick():
Public Sub ButtonClick()
Static n1 As Long, s1 As String, n2 As Long, s2 As String
RangeValue 1, 100, "A1", n1, s1
RangeValue 1, 150, "B1", n2, s2
End Sub
Private Sub RangeValue(MIN As Long, MAX As Long, OUT As String, n As Long, s As String)
Dim i As Long
Const DEL = "."
Randomize
Do
i = Rnd * (MAX - MIN) + MIN
If 0 = InStr(s, i & DEL) Then
n = n + 1: s = s & i & DEL
Range(OUT) = i
If n > MAX - MIN Then n = 0: s = ""
Exit Do
End If: DoEvents
Loop
End Sub
EDIT #2
While the above methods are concise, we can be more efficient by permuting the set of values in an array, and by avoiding the selection of values that have already been output. Here is a version that uses Durstenfeld's implementation of the Fisher–Yates shuffle algorithm:
Public Sub ButtonClick()
Static n As Long, a
Const MIN = 1, MAX = 100, OUT = "A1"
If n = 0 Then a = Evaluate("transpose(row(" & MIN & ":" & MAX & "))"): n = UBound(a)
PermuteArray a, n: Range(OUT) = a(n): n = n - 1
End Sub
Private Sub PermuteArray(a, n As Long)
Dim j As Long, t
Randomize
j = Rnd * (n - 1) + 1
If j <> n Then t = a(j): a(j) = a(n): a(n) = t
End Sub
Fisher–Yates has the advantage that it can be stopped and started as needed and so I am using it on the fly to permute the next value to display on each button click.
And to round this out with a version to use with your scenario of two output cells that use different value ranges:
Public Sub ButtonClick()
Static n1 As Long, n2 As Long, a1, a2
Const MIN1 = 1, MAX1 = 100, OUT1 = "A1"
Const MIN2 = 1, MAX2 = 150, OUT2 = "B1"
If n1 = 0 Then Reset a1, n1, MIN1, MAX1
If n2 = 0 Then Reset a2, n2, MIN2, MAX2
PermuteArray a1, n1: Range(OUT1) = a1(n1): n1 = n1 - 1
PermuteArray a2, n2: Range(OUT2) = a2(n2): n2 = n2 - 1
End Sub
Private Sub PermuteArray(a, n As Long)
Dim j As Long, t
Randomize
j = Rnd * (n - 1) + 1
If j <> n Then t = a(j): a(j) = a(n): a(n) = t
End Sub
Private Sub Reset(a, n As Long, MIN As Long, MAX As Long)
a = Evaluate("transpose(row(" & MIN & ":" & MAX & "))"): n = UBound(a)
End Sub
EDIT #3
I decided to create a version of this that utilizes the "inside-out" variation of Fisher–Yates. This allows us to specify the array of range values and shuffle it at the same time, an elegant and even more efficient enhancement:
Public Sub ButtonClick()
Const MIN = 1, MAX = 100, OUT = "A1"
Static a, n&
If n = 0 Then Reset a, n, MIN, MAX
Range(OUT) = a(n): n = n - 1
End Sub
Private Sub Reset(a, n&, MIN&, MAX&)
Dim i&, j&
Randomize: n = MAX - MIN + 1: ReDim a(1 To n)
For i = 1 To n
j = Rnd * (i - 1) + 1: a(i) = a(j): a(j) = i - 1 + MIN
Next
End Sub
And to expand on your requirement of two different output cells that each use different value ranges, I decided to craft a generalized solution that can be used for an arbitrary number of independent output cells each tied to its own value range:
Public Sub ButtonClick()
Dim MIN, MAX, OUT, i
Static a, n, z
MIN = Array(1, 11, 200): MAX = Array(100, 20, 205): OUT = Array("A1", "B2", "C3")
z = UBound(MIN)
If Not IsArray(n) Then ReDim a(z): ReDim n(z)
For i = 0 To z
If n(i) = 0 Then Reset a(i), n(i), MIN(i), MAX(i)
Range(OUT(i)) = a(i)(n(i)): n(i) = n(i) - 1
Next
End Sub
Private Sub Reset(a, n, MIN, MAX)
Dim i, j
Randomize: n = MAX - MIN + 1: ReDim a(1 To n)
For i = 1 To n
j = Rnd * (i - 1) + 1: a(i) = a(j): a(j) = i - 1 + MIN
Next
End Sub
While the above is setup for three outputs, simply adjust the MIN, MAX, and OUT arrays near the top to suit your needs.
Here's a button click handler that uses static variables to hold an array containing a random sequence of numbers from 1 to 100, as well as the current position/index within that array. The array is created by populating a collection with numbers from 1 to 100, then transferring each number to the array in a random order.
Sub Button1_Click()
Static NumberArray As Variant
Static intIndex As Long
If Not IsArray(NumberArray) Then NumberArray = GetRandomArray()
' If we haven't reached the end of our sequence, get another number...
If intIndex < 100 Then
Sheets("Sheet1").Range("A1") = NumberArray(intIndex)
intIndex = intIndex + 1
End If
End Sub
Function GetRandomArray() As Variant
Dim c As New Collection
Dim a(99) As Long
' Seed the RNG...
Randomize
' Add each number to our collection...
Dim i As Long
For i = 1 To 100
c.Add i
Next
' Transfer the numbers (1-100) to an array in a random sequence...
Dim r As Long
For i = 0 To UBound(a)
r = Int(c.Count * Rnd) + 1 ' Get a random INDEX into the collection
a(i) = c(r) ' Transfer the number at that index
c.Remove r ' Remove the item from the collection
Next
GetRandomArray = a
End Function
Try this:
Dim Picks(1 To 100) As Variant
Dim which As Long
Sub Lah()
Dim A As Range
Set A = Range("A1")
If A.Value = "" Then
which = 1
For i = 1 To 100
Picks(i) = i
Next i
Call Shuffle(Picks)
Else
which = which + 1
If which = 101 Then which = 1
End If
A.Value = Picks(which)
End Sub
Sub Shuffle(InOut() As Variant)
Dim HowMany As Long, i As Long, J As Long
Dim tempF As Double, temp As Variant
Hi = UBound(InOut)
Low = LBound(InOut)
ReDim Helper(Low To Hi) As Double
Randomize
For i = Low To Hi
Helper(i) = Rnd
Next i
J = (Hi - Low + 1) \ 2
Do While J > 0
For i = Low To Hi - J
If Helper(i) > Helper(i + J) Then
tempF = Helper(i)
Helper(i) = Helper(i + J)
Helper(i + J) = tempF
temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = temp
End If
Next i
For i = Hi - J To Low Step -1
If Helper(i) > Helper(i + J) Then
tempF = Helper(i)
Helper(i) = Helper(i + J)
Helper(i + J) = tempF
temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = temp
End If
Next i
J = J \ 2
Loop
End Sub
EDIT#1
The code begins by examining the destination cell, A1. If the cell is empty the code:
creates an array of 100 values
randomizes that array
initializes a sequential counter
places the first element of the randomized array in A1
If the cell is not empty, the code just places the next element of the randomized array in A1.
If you want to restart the process, clear A1. This will re-shuffle the array.
Here is an approach that maintains a global collection of available numbers and places #N/A in cells below A100. The button's click() sub makes sure that the collection is initialized when it needs to be. In a standard code module (insert -> module) enter:
Public Available As Collection
Public Initialized As Boolean
Sub Initialize()
Dim i As Long, n As Long
Dim used(1 To 100) As Boolean
Set Available = New Collection
If Not Range("A1").Value < 1 Then
n = Cells(Rows.Count, 1).End(xlUp).Row()
For i = 1 To n
used(Cells(i, 1).Value) = True
Next i
End If
For i = 1 To 100
If Not used(i) Then Available.Add i
Next i
Initialized = True
End Sub
Function NextRand()
'assumes that Initialize() has been called
Dim i As Long, num As Long
i = Application.WorksheetFunction.RandBetween(1, Available.Count)
num = Available.Item(i)
Available.Remove i
NextRand = num
End Function
Add a button, then in its event handler add the code to make it look something like:
(the actual name depends on the button and if it is an Active-X button, a forms button or just a shape)
Private Sub CommandButton1_Click()
If (Not Initialized) Or Range("A1").Value < 1 Then Initialize
Dim i As Long, n As Long
If Range("A1").Value < 1 Then
Range("A1").Value = NextRand()
Exit Sub
End If
n = 1 + Cells(Rows.Count, 1).End(xlUp).Row()
If n > 100 Then
Cells(n, 1).Value = CVErr(xlErrNA)
Else
Cells(n, 1).Value = NextRand()
End If
End Sub
Consider sorting a list of 100 random numbers and keeping their initial index. I have two buttons (or labels), one to initialize the list and the other to show the next random value
with code like this:
Const RandomCount As Long = 100
Private m_seq() As Variant ' Keep in memory the random numbers
Private m_current As Long ' Keep in memory the last shown number
Private Sub initializeLabel_Click()
Dim wk As Worksheet
Set wk = Worksheets.Add(Type:=xlWorksheet) 'add a worksheet
ReDim m_seq(1 To RandomCount, 1 To 2) 'Initialize a 2D array
Dim i As Long
For i = 1 To RandomCount
m_seq(i, 1) = i 'add values 1..100 to first column
m_seq(i, 2) = Rnd() 'add random numbers to second column
Next i
'Output the array into the new worksheet
wk.Range("A1").Resize(RandomCount, 2).Value2 = m_seq
' Sort the worksheet
wk.Range("A1").Resize(RandomCount, 2).Sort wk.Range("B1")
'Input the sorted values back into the array
m_seq = wk.Range("A1").Resize(RandomCount, 2).Value2
' Delete the worksheet quietly
Application.DisplayAlerts = False
wk.Range("A1").Resize(RandomCount, 2).ClearContents
wk.Delete
Application.DisplayAlerts = True
'Reset the UI
m_current = 0
[A1].ClearContents
End Sub
Private Sub randomLabel_Click()
m_current = m_current + 1
If m_current > RandomCount Then m_current = 1
[A1].Value2 = m_seq(m_current, 1)
End Sub
The values in the temporary worksheet look like this
and after the sort
of which the first column is used