Assign answer randomly to blocks of cells

[jeffreybrown]

Hi All,

In my spreadsheet, in column C, I have groupings of cells which are grouped by quiz answers. For the most part, the answers are A, B, C, or D, but there are times where the quiz answers could just be A or B. On a couple of occasions, there is a question with A, B, C, D, or E.

What I would like to do with VBA is have these answers filled in randomly. So, for the first block, C6:C9, I would like to randomly assign one of those cells with an answer. Of course, C6 would be A, C7 would be B, and so on.

Then, for instance, C30:C31 is just either A or B. The answers will always only be letters. A thru D, and sometimes E.

If it helps, all of these cells have an Interior.ColorIndex of 19. Is this possible?

 

[Special-K99]

For each question you need to tell VBA how many possible answers there would be.

Maybe create another column (say column F) that indicates the numbers of answers (A or B would be 2, A B C D E would be 5)
Then get VBA to loop down the rows picking a random number from 1 to (whatever the value in column F is)
At the very least you're gonna have to let VBA know how many answers there are to each question.

 

[jeffreybrown]

Thank you for the push in the right direction. Here's what I came up with and it works fine.

Sub AssignRandomLetter()
    Dim ws      As Worksheet: Set ws = ActiveSheet
    Dim Lastrow As Long: Lastrow = ws.Range("B" & Rows.Count).End(xlUp).Row
    Dim myNum   As Long
    Dim cell    As Range
    Dim myLtr   As String
    
    Application.ScreenUpdating = False
    
    Call ClearCells
    
    For Each cell In ws.Range("A5:A" & Lastrow)
    
        If Application.WorksheetFunction.IsNumber(cell.Value) = True Then
 
            myNum = WorksheetFunction.RandBetween(1, cell)
            
            Select Case myNum
                Case 1: myLtr = "A"
                Case 2: myLtr = "B"
                Case 3: myLtr = "C"
                Case 4: myLtr = "D"
                Case 5: myLtr = "E"
            End Select
            
            cell.Offset(myNum, 2).Value = myLtr
            
        End If
        
    Next cell
    
    ws.Range("A1").Value = "Y"

    Application.ScreenUpdating = True
    
End Sub