1

I'm new in VBA. I want to make a random pick cycle like that:

Let's say I have seven elements in an array(1,2,3,4,5,6,7), each time when I pick one element from the array, the total number of elements will decrease by 1. After picking every element, the array will be reset to what I initially defined (1,2,3,4,5,6,7) and do the random pick cycle again. The result of every cycle should be different.

Is it possible to do that in VBA?

4
  • Yes, it is possible to do in VBA. Now that answers the question you have asked, but I suspect you need more information than that. Perhaps you need to think about where you are stuck in doing it yourself and ask about that? Commented Jul 21, 2021 at 3:56
  • BTW, the requirement "the total number of elements will decrease by 1" is made redundant by the "array will be reset" requirement. If you think clearly about what you actually need you might find you can actually solve your own problem. Commented Jul 21, 2021 at 3:58
  • 3
    Your model is incorrect. Randomize when you reset the array, then you can just do a for each over the array. Commented Jul 21, 2021 at 4:20
  • Thanks for everyone's support. I do it for learning purposes and I'll review every single method. (I decided to treat this as a shape selection method in a Tetris game) Commented Jul 21, 2021 at 7:52

3 Answers 3

3

Here's a stateful function that does what you described each time it is called.

Option Base 1
Dim digits, NLeft

Function RemoveDigit() as Integer
Dim Element as Integer
If IsEmpty(digits) or NLeft = 0 Then
    digits = array(1,2,3,4,5,6,7)
    NLeft = 7
End If
Element = WorksheetFunction.RandBetween(1,NLeft)
RemoveDigit = digits(Element)
digits(Element) = digits(NLeft)
digits(NLeft) = RemoveDigit
NLeft = NLeft - 1
End Function

It uses a well known algorithm to arrange digits in a random order. Basically you choose to swap a random element number with the last element. Then you repeat it on an n - 1 sized array, making it a tail-recursive algorithm (although this implementation of it is not recursive).

Delete this if you want to, but here is a suggestion for a test sub:

Sub TestRemoveDigit()
NLeft = 0
For i = 1 To 7
 d = RemoveDigit()
Debug.Print (d)
Next i
End Sub
Sign up to request clarification or add additional context in comments.

4 Comments

This looks neat but a couple of things when I tried it (1) WorksheetFunction.Rand() didn't work for me (Excel 365), I tried just rnd() (2) How do you get the results? Won't it just go through all the recursions and just end up with a single integer when you call it? Example showing how to test it and what the results were would be good.
I think I've got it now - it doesn't exactly use recursion, but because you declared digits and NLeft as globals, each time you call it it picks up another random digit and reduces the (used) size of the array. Have taken the liberty of putting in a possible test sub.
Please correct as necessary. Doing this on tablet from memory- I was especially concerned about remembering the static variable initialization. You're right, this one not recursive; but the basic algorithm is usually written that way.
Changed to actually use a real worksheet function, RandBetween, as opposed to one I made up.
2

I think this should do what you're asking for:

Option Explicit

Global vCurrentArray As Variant

Sub ResetArray()
    vCurrentArray = Array(1, 2, 3, 4, 5, 6, 7)
End Sub

Sub RemoveElementWithIndex(lIndex As Long)
    Dim vTemp() As Variant '* Change the type as needed
    Dim lLBound As Long: lLBound = LBound(vCurrentArray)
    Dim lUBound As Long: lUBound = UBound(vCurrentArray)
    Dim i As Long, v As Variant
    Dim blSkipped As Boolean
    
    If lLBound = lUBound Then '* only 1 element
        Call ResetArray
    Else
        ReDim vTemp(lLBound To lUBound - 1)
        i = lLBound
        For Each v In vCurrentArray
            If i <> lIndex Or blSkipped Then
                vTemp(i) = v
                i = i + 1
            Else
                blSkipped = True
            End If
        Next v
        vCurrentArray = vTemp
    End If
End Sub

Function GetRandomElement() As Variant '* Change the type as needed
    Dim lRandomIndex As Long

    lRandomIndex = WorksheetFunction.RandBetween(LBound(vCurrentArray), UBound(vCurrentArray))
    GetRandomElement = vCurrentArray(lRandomIndex)
    RemoveElementWithIndex lRandomIndex
End Function

Sub TestCycles()
    Dim lCycle As Long
    Dim i As Long
    
    ResetArray
    
    For lCycle = 1 To 3
        Debug.Print
        For i = 1 To 7
            Debug.Print "Cycle: " & lCycle, "i: " & i, "Random Elem: " & GetRandomElement
        Next i
    Next lCycle
End Sub

Note: There're many ways of achieving the end result. The above is almost a literal translation of your post.

Comments

0

We can not remove a random element from an array. We can redim array to remove last element(s). If you want to remove random element, you can use collection instead like ..

Option Explicit
Sub RemoveRandom()
Dim coll As Collection, cl As Variant, i As Long, j As Long
Set coll = New Collection
For Each cl In Range("A1:A7")
    coll.Add cl.Value
Next cl
For j = 1 To coll.Count
    i = WorksheetFunction.RandBetween(1, coll.Count)
    Debug.Print coll(i)
    coll.Remove (i)
Next j
End Sub

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.