Random letter generator

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Micheal Artindale - 13 Apr 2008 23:31 GMT

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

Reply to this Message

Michael Bednarek - 14 Apr 2008 12:19 GMT

>I am looking to create a spreadsheet that has random letter combinations
>such that:
[quoted text clipped - 4 lines]
>
>Any suggestions?

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)

Signature

Michael Bednarek http://mbednarek.com/ "POST NO BILLS"

Reply to this Message

Harlan Grove - 14 Apr 2008 21:16 GMT

"Micheal Artindale" <michealartind...@eastlink.ca> wrote...

>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

...

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

Reply to this Message

Michael Bednarek - 15 Apr 2008 13:10 GMT

>"Micheal Artindale" <michealartind...@eastlink.ca> wrote...
>>I am looking to create a spreadsheet that has random letter
[quoted text clipped - 7 lines]
>So #1 means ABC could appear multiple times, while #2 means AAB, ABB,
>etc would never appear? If so, here's another udf solution.

[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. :-) )

Signature

Michael Bednarek http://mbednarek.com/ "POST NO BILLS"

Reply to this Message

Bernd P - 15 Apr 2008 20:11 GMT

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

Reply to this Message

Harlan Grove - 16 Apr 2008 01:56 GMT

Bernd P <bplumh...@gmail.com> wrote...
...

>Harlan's code favours the i+1. char with double likelihood . . .

...

>This is just a "special form of randomness". If all but the
>previously drawn char should appear with identical likelihood, . . .

...

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

Reply to this Message

Harlan Grove - 16 Apr 2008 02:00 GMT

Michael Bednarek <mbATmbednarek....@BLACKHOLESPAM.NET> wrote...
...

>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.

...

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.

Reply to this Message

Bernd P - 16 Apr 2008 17:18 GMT

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

Reply to this Message