Excel - Random letter generator

Asked By Micheal Artindale on 13-Apr-08 06:31 PM
I am looking to create a spreadsheet that has random letter combinations
such that:
1) it can repeat itself,
2) the letter is never beside itself,
3) I can pick the letters,
4)I can pick the length of the combination

Any suggestions?

Thanks

Micheal




Michael Bednarek replied on 14-Apr-08 07:19 AM
On Sun, 13 Apr 2008 22:31:13 GMT, Micheal Artindale wrote in
microsoft.public.excel:


Here's my suggestion; create this User-defined function:

Function RndLetters(rngLetters As Range, rngLength As Range)
Application.Volatile
Dim lngRnd As Long
Dim strLtrs As String
Dim strLtr As String
Dim strPicked As String
Dim lngLoop As Long
Dim strResult As String

strResult = ""
strLtrs = rngLetters
strPicked = ""
For lngLoop = 1 To rngLength
lngRnd = Int(Len(strLtrs) * Rnd + 1)
strLtr = Mid(strLtrs, lngRnd, 1)
strLtrs = strLtrs & strPicked
strPicked = strLtr
strLtrs = Mid(strLtrs, 1, lngRnd - 1) & Mid(strLtrs, lngRnd + 1)
strResult = strResult & strLtr
Next lngLoop
RndLetters = strResult
End Function

Then enter your desired letters somwhere (say: A1), and the desired
length somewhere else (say: B1). Call the function in any cell like:
=RndLetters(A1,B1)

--
Michael Bednarek   http://mbednarek.com/   "POST NO BILLS"
Harlan Grove replied on 15-Apr-08 08:01 AM
...

So #1 means ABC could appear multiple times, while #2 means AAB, ABB,
etc would never appear? If so, here's another udf solution.


Function foo(ca As String, n As Long) As String
Dim k As Long, p As Long, q As Long

'check for valid parameters
If ca = "" Or n < 1 Or (Len(ca) = 1 And n > 1) Then Exit Function

'prune any duplicates in ca
With Application.WorksheetFunction
For k = 1 To Len(ca) - 1
ca = Left$(ca, k) & _
.Substitute(Mid$(ca, k + 1), Mid$(ca, k, 1), "")
Next k
End With

k = Len(ca)

'recheck for valid parameters
If k = 1 And n > 1 Then Exit Function

For n = n To 1 Step -1
p = Int(k * Rnd + 1)
If p = q Then p = p Mod k + 1
foo = foo & Mid$(ca, p, 1)
q = p
Next n

End Function
Michael Bednarek replied on 15-Apr-08 08:10 AM
On Mon, 14 Apr 2008 13:16:17 -0700 (PDT), Harlan Grove wrote in
microsoft.public.excel:

[snip]

Harlan,

Thank you for your version. For my own edification (and only based on a
reading, not a test, of your code), I would like to summarise the
difference between our solutions, and ask if you agree.

My solution removes the picked letter from the original string for the
next pick; the previously picked letter is then re-added to the end of
the string. The idea is that for a random pick the position of the
letters does not matter.

Your solution is more concise. It remembers the previously picked
letter, and if it is picked in the next draw, it is replaced by the
following (in a round-robin way) letter.

Small critique: ISTM that picking the following letter in case of a
violation of rule 2) does not quite satisfy the demand for randomness.

So - is my reading of the method of your code correct? And, do you agree
that your method is somewhat less random than mine? (Not that I think it
matters much, given the vagaries of Excel's RND function. -- Writing
this made me realise only now that neither solution included a RANDOMIZE
statement. :-) )

--
Michael Bednarek   http://mbednarek.com/   "POST NO BILLS"
Bernd P replied on 15-Apr-08 08:16 PM
Hello,

Harlan's code favours the i+1. char with double likelihood if i has
been chosen previously:
If you call foo("ABC",2), for example, then AB, BC and CA will appear
with likelihood 2/9 while AC, BA and CB will show up with only 1/9
likelihood.

This is just a "special form of randomness". If all but the previously
drawn char should appear with identical likelihood, you can use for
example:

Function RndStringNTWChar(s As String, n As Long) As String
'Create random string with non-twin characters.
's contains valid characters, n length of returned string.
Dim i As Long, j As Long, k As Long, m As Long

'Check for valid parameters
If s = "" Or n < 1 Or (Len(s) = 1 And n > 1) Then
RndStringNTWChar = CVErr(xlErrValue)
Exit Function
End If

'Prune any duplicates in s
i = 1
Do While i < Len(s)
s = Left$(s, i) & _
Application.WorksheetFunction.Substitute(Mid$(s, _
i + 1), Mid$(s, i, 1), "")
i = i + 1
Loop

i = Len(s)

'Recheck for valid parameters
If i = 1 And n > 1 Then
RndStringNTWChar = CVErr(xlErrValue)
Exit Function
End If

m = i
For n = n To 1 Step -1
j = Int(m * Rnd + 1)
If m <> i And j >= k Then j = j + 1
RndStringNTWChar = RndStringNTWChar & Mid$(s, j, 1)
k = j
m = i - 1
Next n

End Function

Regards,
Bernd
Harlan Grove replied on 18-Apr-08 02:04 AM
Bernd P <bplumh...@gmail.com> wrote...
...
...
...

I was trying to generate the entire result string in the loop. That
was a mistake.

Yet another version.


Function foo(ca As String, n As Long) As String
Dim k As Long, p As Long, q As Long

'check for valid parameters
If ca = "" Or n < 1 Or (Len(ca) = 1 And n > 1) Then Exit Function

'prune any duplicates in ca
With Application.WorksheetFunction
For k = 1 To Len(ca) - 1
ca = Left$(ca, k) & _
.Substitute(Mid$(ca, k + 1), Mid$(ca, k, 1), "")
Next k
End With

k = Len(ca)

'recheck for valid parameters
If k = 1 And n > 1 Then Exit Function

q = Int(k * Rnd + 1)
foo = Mid$(ca, q, 1)
k = k - 1

For n = n To 2 Step -1
p = Int(k * Rnd + 1)
q = IIf(p < q, p, p + 1)
foo = foo & Mid$(ca, q, 1)
Next n

End Function
Harlan Grove replied on 18-Apr-08 02:04 AM
Michael Bednarek <mbATmbednarek....@BLACKHOLESPAM.NET> wrote...
...
...

Lack of randomness in my first udf was an error. I replied to Bernd P
with a fixed version.

VBA is generally inefficent with string processing, so I avoid it to
the extent I can. Thus only removing duplicate characters from the
string argument containing the possible characters.
Bernd P replied on 18-Apr-08 02:05 AM
Hello,

Another, more general UDF:

Function rl(s As String, n As Long) As Variant
'Create random string with non-twin characters.
's contains valid characters, n length of returned string.
'Repeating characters increase likelihood correspondingly,
'i.e. rl("AAB",1) will result in "A" with likelihood 2/3 and
'in "B" with likelihood 1/3
Dim i As Long, j As Long, k As Long, m As Long
Dim iarr(0 To 255) As Integer

'Check for valid parameters
If s = "" Or n < 1 Or (Len(s) = 1 And n > 1) Then
rl = CVErr(xlErrValue)
Exit Function
End If

For i = 1 To Len(s)
j = Asc(Mid(s, i, 1))
iarr(j) = iarr(j) + 1
Next i

j = Int(RandHistogrm(0#, 256#, iarr))
k = j       'store position
m = iarr(j) 'store likelihood
iarr(j) = 0 'avoid twin in next run
rl = Chr(j)

For i = 2 To n
j = Int(RandHistogrm(0#, 256#, iarr))
'http://www.sulprobil.com/html/histogrm.html
iarr(k) = m 'restore previous likelihood
k = j
m = iarr(j)
iarr(j) = 0
rl = rl & Chr(j)
Next i

End Function

Regards,
Bernd