Public Function randBetweenExcludeRange(lngBottom As Long, lngTop As Long, _
rngExcludeValues As Range) As Variant
Dim c As Range
Dim dict As Object
Dim i As Long
Dim blNoItemsAvailable As Boolean
Dim lngTest As Long
'some notes on code:
'It'd probably be a good idea to check for values that are only integers in the range
'you might be able to sort the already excluded values, choose a number between 1 and
'the number of remaining available values and then generate that from a full list of
'values. (maybe by making the dictionary hold available values only?)
'I'm pretty sure the comment above doesn't make a lot of sense. If it
'did, i'd have tried to implement it.
If lngBottom > lngTop Then
randBetweenExcludeRange = CVErr(xlErrNA)
Exit Function
End If
'get a list of all items in range
'i = 0
Set dict = CreateObject("Scripting.dictionary")
For Each c In rngExcludeValues
'I should have really only checked for c.values that are longs.
If IsNumeric(c.Value) Then
If c.Value >= lngBottom And c.Value<= lngTop Then
If Not dict.exists(c.Value) Then
dict.Add c.Value, ""
End If
End If
End If
Next c
'check to make sure that there are values available to use
If dict.Count >= lngTop - lngBottom + 1 Then
'initialize error holder to true
blNoItemsAvailable = True
For i = lngBottom To lngTop
If Not dict.exists(i) Then
blNoItemsAvailable = False
Exit For
End If
Next i
End If
If blNoItemsAvailable Then
randBetweenExcludeRange = CVErr(xlErrNA)
Exit Function
End If
'this bit could (probably) be made a lot more efficient. see notes at top
'of code
Do
lngTest = Int(Rnd() * (lngTop - lngBottom + 1)) + lngBottom
If Not dict.exists(lngTest) Then
randBetweenExcludeRange = lngTest
Exit Function
End If
Loop
End Function
