2

G'day,

I have a tricky problem with getting random numbers in sorted order according to how many I need by either VBA code or formula within VBA. This need is generated randomly between 1 and 10.

It looks something like this when it starts.

enter image description here

and here is the effect I had in mind where it shows sorted numbers according to how many failed in the example.

enter image description here

This is one attempt by VBA I did where cell J7 contains the random of how many I need but the numbers not quite sorted. I'm open to suggestions/feedback here. Many thanks.

Public Const BeCoolMachineCounter As String = "J7"
Public Const BeCoolMachineRange As String = "Q03:Q12"
'Generate the random data according to how many needed.
Call CreateNumbers(Range(BeCoolMachineRange), Range(BeCoolMachineCounter).Value)
Private Sub CreateNumbers(Which As Range, HowMany As Integer)
' Declaration of variables
    Dim c As Range
    Dim iCheck As Long

    iCheck = 1

' Generate random failures based on the number of required for each supplier
    For Each c In Which
        If iCheck <= HowMany Then
            c.Value = Random1to2192
            iCheck = iCheck + 1
        End If
    Next c
End Sub
Peter M Taylor
  • 183
  • 1
  • 9
  • 17

2 Answers2

2

You could use an array formula in the destination range and a UDF returning the array.

It gives you exactly the result you're showing.

So, the UDF :

Public Function GetRandomFailures(count As Long) As Variant
    Dim result As Variant, numbers As Variant
    ReDim result(100)
    ReDim numbers(count - 1)

    For i = 0 To count - 1
        numbers(i) = Application.WorksheetFunction.RandBetween(1, 10000)
    Next i

    Call QuickSort(numbers, LBound(numbers), UBound(numbers))

    For i = 0 To 99
        If i < count Then
            result(i) = numbers(i)
        Else
            result(i) = ""
        End If
    Next i

    GetRandomFailures = Application.WorksheetFunction.Transpose(result)
End Function

Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)

  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long

  tmpLow = inLow
  tmpHi = inHi

  pivot = vArray((inLow + inHi) \ 2)

  While (tmpLow <= tmpHi)

     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend

     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend

     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If

  Wend

  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi

End Sub

and a sample formula :

{=GetRandomFailures(A1)}

(braces added by Excel)

You can of course simply call this UDF from a macro but IMHO using an array-formula could improve the user experience as all is transparent and the list is refreshed each time you change the count.

Note : the quick-sort implementation is from here : VBA array sort function?

Community
  • 1
  • 1
Pragmateek
  • 13,174
  • 9
  • 74
  • 108
1

I'm not sure I understand what you've said, but based on the Before and After I've assumed you already have the 10 numbers in the column and you want to get a random sample of size HowMany from them and then make sure the numbers taken are then sorted in order.

Public Sub RandomSample(Data10 As Range, HowMany As Integer)

    ' Insert random numbers next to the data
    Data10.Cells(1, 2).FormulaR1C1 = "=RAND()"
    Data10.Cells(1, 2).AutoFill Destination:=Range(Data10.Cells(1, 2), Data10.Cells(10, 2))

    ' Sort the data by the random numbers
    Range(Data10.Cells(1, 1), Data10.Cells(10, 2)).Sort key1:=Data10.Cells(1, 2), header:=xlNo
    ' Remove the random numbers
    Range(Data10.Cells(1, 2), Data10.Cells(10, 2)).ClearContents

    ' Remove numbers surplus to HowMany
    If HowMany < 10 Then
        Range(Data10.Cells(HowMany + 1, 1), Data10.Cells(10, 1)).ClearContents
    End If

    ' Resort the remaining numbers
    Range(Data10.Cells(1, 1), Data10.Cells(HowMany, 1)).Sort key1:=Data10.Cells(1, 1), header:=xlNo

End Sub

You can call this with RandomSample Range("B3:B12"),6

Morbo
  • 541
  • 2
  • 6
  • Hi Morbo, Yes that is correct, 10 numbers and in sorted order. I used 10 numbers in the static pictures I provided as a small sample for illustrative purposes. I'll have a look at what this code does and see if this fits to what I had in mind. Thanks. – Peter M Taylor Jan 06 '13 at 01:05
  • I had a go with this code and I believe the sorting is not working as it clears the data once populated. – Peter M Taylor Jan 06 '13 at 02:58
  • It worked for me in Excel 2003 as I have described in the comments. If you want 3 numbers it WILL delete the remaining 7 numbers. – Morbo Jan 06 '13 at 19:26