Random Letters

[mdorey]

hello friends...

I'm here to ask for you help to do a sheet with random lettes...

I got this macro but is not working

Sub RandomLetters()
Dim RandomRange As Range, cell As Range
Set RandomRange = Range("C10:AG15")
For Each cell In RandomRange
cell.Formula = "=RANDL(A,M)"
Next
RandomRange.Value = RandomRange.Value
End Sub

The range is set. but the cell.formula is not... i want to set the macro to random the letters (N ,M, T, E, DS) without their being repeated at the same collun is that possible???

TY

 

[Rick Rothstein]

This thread seems to be the closests thing to what I'm looking for (and I've searched a lot). I have tried to modify the above code and am at a loss (as well as trying cpearson and ozgrid unique random functions).

The application is for a quick re-assigning and posting of audition letters for the 2nd round of an audition. I need a function or sub that will return a list of unique random letters where the amount of letters selected from, and the range they are returned to, is equal to a different amount each time. In other words, I need to randomly assign letters A-G to a group of 7 advancing from one room. But then letters A-L to a group of 12 advancing from another room. All rooms are on the same sheet and I know I could use a "Countifs" to determine the amount from one room versus another.

I'm not 100% sure what you are looking for here; but, because you asked your question in this thread, I'll assume you want your letters randomized down each column for as many columns as you specify. Here is a macro which will ask you for your letters (they can be more than one character each if desired) and the range you want to distribute them in.

Sub DistributeRandomLettersNoRepeatsInColumns()
  Dim X As Long, RandomIndex As Long, Col As Range, FillRange As Range
  Dim TempElement As String, Answer As String, Arr() As String
  Answer = WorksheetFunction.Trim(InputBox("Please enter your letters separated by a single blank space...", "Enter Unique Letters"))
  If Len(Answer) = 0 Then
    MsgBox "No letters were entered!", vbCritical
    Exit Sub
  End If
  Arr = Split(Answer)
  Set FillRange = Application.InputBox("Please enter the range you want to fill...", "Enter Columns To Be Filled", Type:=8)
  If FillRange.Rows.Count <> UBound(Arr) + 1 Then
    MsgBox "The number of rows in " & FillRange.Address(0, 0) & " does not equal the number of letters you want to distribute down them!", vbCritical
    Exit Sub
  End If
  For Each Col In FillRange
    For X = UBound(Arr) To 0 Step -1
      RandomIndex = Int((X - LBound(Arr) + 1) * Rnd + LBound(Arr))
      TempElement = Arr(RandomIndex)
      Arr(RandomIndex) = Arr(X)
      Arr(X) = TempElement
    Next
    Col = WorksheetFunction.Transpose(Arr)
  Next
End Sub

 

[neugna]

Thanks! This is much closer to what I want. However, the letters need to be uniquely selected...i.e., they can't repeat as there can be only one Letter A, one Letter B, etc.

And I need it to determine the number of letters based off audition results in another column: Column A tells whether they "Advance to Phase 2" (or is blank if not) and then column F needs to paste a random (non-repeating) letter only for those advancing to Phase 2.

I will look at the code you gave me and see if I know how to modifiy it but I doubt I'm that advanced.

 

[Rick Rothstein]

Thanks! This is much closer to what I want. However, the letters need to be uniquely selected...i.e., they can't repeat as there can be only one Letter A, one Letter B, etc.

And I need it to determine the number of letters based off audition results in another column: Column A tells whether they "Advance to Phase 2" (or is blank if not) and then column F needs to paste a random (non-repeating) letter only for those advancing to Phase 2.

I will look at the code you gave me and see if I know how to modifiy it but I doubt I'm that advanced.

Can you describe your setup in more detail for us? Also if you show us a example before and then what it should look like afterwards, that would probably helps us.

 

[neugna]

Man I suck...I cannot figure out how to post Excel examples. I read Steve's thread on how to post but none of those work I think because I'm on a Mac using Safari?

 

[Rick Rothstein]

Man I suck...I cannot figure out how to post Excel examples. I read Steve's thread on how to post but none of those work I think because I'm on a Mac using Safari?

Being on a Mac may be the problem (I don't know for sure, but the indicated methods work on PCs). For those of us brave enough to open posted files, you can post your workbook online using one of these free posting websites...

Box: http://www.box.net/files
MediaFire: http://www.mediafire.com
FileFactory: http://www.filefactory.com
FileSavr: http://www.filesavr.com
FileDropper: http://www.filedropper.com
RapidShare: http://www.rapidshare.com

Then post the URL they give you for the file back here.

 

[neugna]

Duh...posted on my own website on an unpublished link. Its on the first sheet "Sample Sheet". If you are worried about macro security (as some are), I'll post an xlsx version too.

http://www.howardband.com/Excelfile.htm

Thanks,
Nate

 

[neugna]

Ok...trying to make this easier to get some help. Here is Ozgrid's VBA for unique randoms function that I've changed to a Sub. Its still in numbers but changing it to letters will be easy later. I even have gotten the output to resize for the amount of people advancing (from the Inputbox which I will change later to be a countif). But I can't get the array of strings to transpose into single cells within that range. If you can help me with that, I think I can get the rest:

Sub RandLottoA()

    Dim Bottom As Integer
    Dim Top As Integer
    Dim Amount As Integer
    Dim RL As String
    
    Bottom = 1
    Top = InputBox("Enter # Advancing", "Unique Randoms")
    Amount = Top
    
    Dim iArr As Variant
    Dim i As Integer
    Dim R As Integer
    Dim temp As Integer
    ReDim iArr(Bottom To Top)

    For i = Bottom To Top
        iArr(i) = i
    Next i

    For i = Top To Bottom + 1 Step -1
        R = Int(Rnd() * (i - Bottom + 1)) + Bottom
        temp = iArr(R)
        iArr(R) = iArr(i)
        iArr(i) = temp
    Next i

    For i = Bottom To Bottom + Amount - 1
        RL = RL & " " & iArr(i)
    Next i

    RL = Trim(RL)
    Range("f2").Resize(Amount, 1) = RL
End Sub

 

[shg]

Public Function RandLong(Optional iMin As Long = 1, _
                         Optional iMax As Long = -2147483647, _
                         Optional bVolatile As Boolean = False) As Variant
    ' UDF only!
    ' Returns numbers between iMin and iMax to the calling range
    ' UDF wrapper for aiRandLong
    
    ' shg 2008
    Dim nRow        As Long     ' rows in calling range
    Dim nCol        As Long     ' columns in calling range
    Dim iRow        As Long     ' row index
    Dim iCol        As Long     ' col index
    Dim aiTmp()     As Long     ' 1D temp array
    Dim aiOut()     As Long     ' output array
 
    If bVolatile Then Application.Volatile True
 
    With Application.Caller
        nRow = .Rows.Count
        nCol = .Columns.Count
    End With
 
    ReDim aiOut(1 To nRow, 1 To nCol)

    If iMin = 1 And iMax = -2147483647 Then iMax = nRow * nCol
    aiTmp = aiRandLong(iMin, iMax, nRow * nCol)
 
    For iRow = 1 To nRow
        For iCol = 1 To nCol
            aiOut(iRow, iCol) = aiTmp((iCol - 1) * nRow + iRow)
        Next iCol
    Next iRow
    RandLong = aiOut
End Function
 
Public Function aiRandLong(iMin As Long, _
                           iMax As Long, _
                           Optional ByVal n As Long = -1, _
                           Optional bVolatile As Boolean = False) As Long()
    ' UDF or VBA
    ' Fisher-Yates shuffle
    ' Returns a 1-based array of n unique Longs between iMin and iMax inclusive
    Dim aiSrc()     As Long     ' array of numbers iMin to iMax
    Dim iSrc        As Long     ' index to aiSrc
    Dim iTop        As Long     ' decreasing upper bound for next selection
    Dim aiOut()     As Long     ' output array
    Dim iOut        As Long     ' index to aiOut
 
    If bVolatile Then Application.Volatile True
 
    If n < 0 Then n = iMax - iMin + 1
    If iMin > iMax Or n > (iMax - iMin + 1) Or n < 1 Then Exit Function
 
    ReDim aiSrc(iMin To iMax)
    ReDim aiOut(1 To n)
 
    ' init iSrc
    For iSrc = iMin To iMax
        aiSrc(iSrc) = iSrc
    Next iSrc
 
    iTop = iMax
    For iOut = 1 To n
        ' Pick a number in aiSrc between 1 and iTop, copy to output,
        ' replace with the number at iTop, decrement iTop
        iSrc = Int((iTop - iMin + 1) * Rnd) + iMin
        aiOut(iOut) = aiSrc(iSrc)
        aiSrc(iSrc) = aiSrc(iTop)
        iTop = iTop - 1
    Next iOut
 
    aiRandLong = aiOut
End Function

Then select six cells (e.g., A1:F1, or A1:C2, or A1:B3, or A1:A6), and array-enter

=MID("NMTEDS", RandLong(), 1)