Generating same random number max 6 times vba

Question

My problem is that I am trying to do a series of random numbers let say between 1-10 and these numbers are going to be spread out on like 50 posts and the same random number can only occur max 6 times.

(Edited)

My current code is written that I count the rows with a value divided with 6 to determine how many different random numbers I need. If 58 cells have value i need random numbers between 1-10. I think the max Rows i need will be 200

Dim i As Integer
Dim a As Integer

a1 = ActiveSheet.UsedRange.Rows.Count

Range("E1") = a1

For i = 1 To a1
MinNumber = 1
MaxNumber = a1 / 6
Range("D1") = MaxNumber

Cells(i, 1).Value = Int((Rnd * (MaxNumber - MinNumber + 1)) + MinNumber)
Next i

It looks like the range of numbers is from 1 to the number of used rows, so one option would be to use the random number as an index to a row number. Every time a number is generated, go to that row number and increment a counter in some far off column. Do all that inside your loop and if you exceed the max of '6', then just generate another number. How many rows do you expect to generate for? If a small number, then you could just create an array. — Wayne G. Dunn, Apr 15 '14 at 12:54
Quick note: the `.UsedRange.Rows.Count` method for finding the last row in a worksheet is very unreliable. There is an excellent post here about how to more reliably determine the last row http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba — Dan Wagner, Apr 15 '14 at 13:05
Thx Dan I Will change that. Wayne I understand your point but I really dont know how to carry it out. — PercyN, Apr 15 '14 at 13:35
You could use a dictionary to hold your items, then remove them one by one. See my code on this at [VBAX](http://www.vbaexpress.com/kb/getarticle.php?kb_id=67) — brettdj, Apr 15 '14 at 13:45

score 3 · Accepted Answer · answered Apr 18 '14 at 02:06

This code uses a Dictionary to enter the initial range of required numbers, and then remove them one by one.

Sub Recut()

Dim a As Long

Dim objDic As Object
Dim lngCnt As Long
Dim lngCnt2 As Long
Dim lngCnt3 As Long

Dim lngTot As Long
Dim lngOut As Long
Dim lngNum As Long

lngTot = Application.InputBox("Input number of items to generate", , ActiveSheet.UsedRange.Rows.Count)

Set objDic = CreateObject("scripting.dictionary")
MinNumber = 1
MaxNumber = Int(lngTot / 6) + 1

For lngCnt = 1 To 6
    For lngCnt2 = 1 To MaxNumber
        lngCnt3 = lngCnt3 + 1
        objDic.Add lngCnt2 & "|" & lngCnt, lngCnt3
    Next
Next

For lngOut = 1 To a
    lngNum = Int(Rnd() * objDic.Count)
    Cells(lngOut, 1) = Application.Index(Split(objDic.Keys(lngNum), "|"), 1)
    objDic.Remove objDic.Keys(lngNum)
Next
End Sub

Hello Brett, I had to change it down at the "Keys" to get it to work. I had to write it like Keys() (Lngnum) now it works. — PercyN, May 13 '14 at 08:09

score 1 · Answer 2 · answered Apr 15 '14 at 13:59

The following is a version of your code that will use an array, Note that you said max of 200 rows, so beware if > 200. If same number generated more than 6 times, then will find an alternate. You can remove the Debug.Print' if annoying.

Option Explicit

Sub Random_Numbers()

Dim i           As Integer
Dim a           As Integer
Dim lLastRow    As Long
Dim MinNumber   As Long
Dim MaxNumber   As Long
Dim lRndNbr     As Long
Dim aLimitTo6(200) As Integer

    lLastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    Range("E1") = lLastRow

    If lLastRow > 200 Then
        MsgBox "You are generating numbers for more than 200 rows!! Either increase the Array, or go to 'Plan B'"
        Exit Sub
    End If

    MinNumber = 1
    MaxNumber = lLastRow / 6
    Range("D1") = MaxNumber

    For i = 1 To lLastRow
        lRndNbr = Int((Rnd * (MaxNumber - MinNumber + 1)) + MinNumber)
        aLimitTo6(lRndNbr) = aLimitTo6(lRndNbr) + 1
        If aLimitTo6(lRndNbr) > 6 Then
            Debug.Print lRndNbr & " already generated six times!!"
            Do      ' Try forever?
                lRndNbr = Int((Rnd * (MaxNumber - MinNumber + 1)) + MinNumber)
                aLimitTo6(lRndNbr) = aLimitTo6(lRndNbr) + 1
                If aLimitTo6(lRndNbr) > 6 Then
                    Debug.Print "Tried once to get another random number (" & lRndNbr & "), but failed!! What do you want to do?"
                Else
                    Cells(i, 1).value = lRndNbr
                    Exit Do
                End If
            Loop
        Else
            Cells(i, 1).value = lRndNbr
        End If
    Next i
End Sub

Thanks a lot Wayne. It works perfect, just changed the printing row to nr 2 instead of 1. Thx again — PercyN, Apr 16 '14 at 06:33

Generating same random number max 6 times vba

2 Answers2