Randomly Change order of Questions (Excel 2010/Win10)

[JimmyC]

I have a worksheet (Sheet1) that has a "study/review" question in Column A. In Column B, there is a data validation / list of four items and the user is to select the correct answer. There are 110 rows of questions and answers. On Sheet2, I copy the question in Column A and the answer selected in column B from Sheet1 to Columns A and B respectively in sheet 2. In Column C is the "correct" answer. In Column D is a simple if statement that tells the user whether she selected the correct answer (i.e. Compares cell value in Column B to Column C). This workbook is used for self-study, exam preparation, etc. it is not to be used for "official" testing or validation.

Initially our Human Resource trainer was happy with the workbook as described in the paragraph above. But now she has asked me to have the questions appear in random order on Sheet 1 each time the workbook is opened. This means that I have to sort/relocate cells in both column A and column B since the answer to the question (column B) is tied to the question in Column A. Additionally, I am not sure how to "link" the answer that is on Sheet2 Column C once Columns A and B are randomly resorted. I think I need to bring the answer to another column on Sheet1 and hide it so that this column is also moved when Columns A and B are resorted and listed in random order.

I am guessing this is well beyond the random function since I need to re-order the questions based on the random numbers generated. I am terrible at creating VBA but can make changes to code once I understand how it works. I assume also that the VBA code would need to activate when the workbook is opened since the questions are to be in random order. Is that possible?

Any and all advice is welcome---including design suggestions to make this work correctly. My fear is that through randomizing the questions, that I somehow "disconnect" the correct answer from the question and the user ends up learning the "incorrect" definitions for vocabulary words. Thank you. Jimc

[HansV]

Yes, that's possible.

It would be easiest if you could attach a (stripped down) copy of the workbook without sensitive information.
If that is too difficult, I could create a sample workbook, but then you'd have to translate it to your own situation.

[JimmyC]

Hans--Thanks. I will have to secure permission to release the workbook; in the interim, I may just take the first five questions, and re-word them to give you an idea of what I am trying to accomplish. Thanks again. Jim

[HansV]

A workbook with 5 reworded questions would be fine!

[JimmyC]

Hans,
Stripped down version attached. I currently have seven similar workbooks. The number of questions on Sheet1 vary from 92 to a current maximum of 152. I also thought of an additional issue. Currently the workbook cannot be saved--so that the answers are not saved since this is meant as a study tool and can be used multiple times. When I first create the workbook, all of the answer are defaulted to None (i.e. Column B on Sheet1). The attached demo file has the questions already answered (i.e. 3 correct answers and 2 incorrect answers) so you can see what happens on Sheet2. So can the code that will randomize the order of the questions also "reset" the answers to "None" or will I need to continue to prohibit saving of the workbook? Thank you for your help.
Jim

[HansV]

Here is the Workbook_Open event procedure in the ThisWorkbook module:

Code: Select all

Private Sub Workbook_Open()
    Const FirstRow As Long = 5
    Dim CurRow As Long
    Dim LastRow As Long
    Dim Counter As Long
    Application.ScreenUpdating = False
    LastRow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
    Sheet1.Range("B" & FirstRow & ":B" & LastRow).ClearContents
    For Counter = 1 To 2 * (LastRow - FirstRow + 1)
        CurRow = Application.WorksheetFunction.RandBetween(FirstRow + 1, LastRow)
        Sheet1.Range("A" & CurRow).Resize(1, 2).Cut
        Sheet1.Range("A" & FirstRow).Resize(1, 2).Insert Shift:=xlShiftDown
        Sheet2.Range("A" & CurRow).Resize(1, 4).Cut
        Sheet2.Range("A" & FirstRow).Resize(1, 4).Insert Shift:=xlShiftDown
    Next Counter
    Application.ScreenUpdating = True
End Sub

The replies will be cleared when the workbook is opened. See the attached version (now a .xlsm workbook) below.

hans_eileens_lounge_stripped_example.xlsm

[JimmyC]

Hans--thank you. Off to study your suggestions. Again, thank you. Jim

[JimmyC]

Hans--I am working on this and the trainer asked to change the name of Sheet1 to Take_Quiz and Sheet2 to Quiz_Answers. I thought that I could merely change the code substituting Take_Quiz where Sheet1 is and Quiz_Answers for Sheet2. But this doesn't work, as I get a compile error --variable undefined, with the Take_Quiz highlighted in the parenthesis in this line of code. Must you Dim a sheet name if it is different from the standard Sheet1, Sheet2, etc. ? I even eliminated the under score and name the sheet TakeQuiz---but that doesn't solve the issue either. Thanks for your patience. Jim

LastRow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row

[Rudi]

Looking at Hans's code above, he is using the actual sheet object name. IOW, Sheet1 is the sheet object name and not the sheets tab name.

If you change the names of the two sheets, you will need to substitute the sheet names in the code as follows;

Sheet1. - must change to Sheets("Take_Quiz").
Sheet2. - must change to Sheets("Quiz_Answers").

If you do a find/replace in your code with the changes as above, it should work OK...

[Rudi]

I had a moment to do the replacement...

Try this (untested on my side!)

Code: Select all

Private Sub Workbook_Open()
    Const FirstRow As Long = 5
    Dim CurRow As Long
    Dim LastRow As Long
    Dim Counter As Long
    Application.ScreenUpdating = False
    LastRow = Sheets("Take_Quiz").Range("A" & Sheets("Take_Quiz").Rows.Count).End(xlUp).Row
    Sheets("Take_Quiz").Range("B" & FirstRow & ":B" & LastRow).ClearContents
    For Counter = 1 To 2 * (LastRow - FirstRow + 1)
        CurRow = Application.WorksheetFunction.RandBetween(FirstRow + 1, LastRow)
        Sheets("Take_Quiz").Range("A" & CurRow).Resize(1, 2).Cut
        Sheets("Take_Quiz").Range("A" & FirstRow).Resize(1, 2).Insert Shift:=xlShiftDown
        Sheets("Quiz_Answers").Range("A" & CurRow).Resize(1, 4).Cut
        Sheets("Quiz_Answers").Range("A" & FirstRow).Resize(1, 4).Insert Shift:=xlShiftDown
    Next Counter
    Application.ScreenUpdating = True
End Sub

[JimmyC]

Rudi, Thanks....but now I get a Run_Time Error code 9, subscript out of range error when I open the Excel file. Thanks again for helping me. Jim

PS...I found an extra space that was highlighted from coping your code from the lounge to the Excel module...I deleted it and all is good. Rudi--thank you! Jim

[JimmyC]

Hans,
Can you help me learn further and explain how this loop works? I have googled some of the code you used, but I just can't put it together beyond discerning the "cut" and "reinsert". How are the questions re-sorted or placed in random order as I don't seem to see any code for that? I also don't know how you were able to keep the "answers" in Column C on Sheet2 in sync with the question in Column A on Sheet1 when the questions are resorted. This is amazing stuff. Thank you for your patience. Jim

Code: Select all

 Sheet1.Range("B" & FirstRow & ":B" & LastRow).ClearContents
    For Counter = 1 To 2 * (LastRow - FirstRow + 1)
        CurRow = Application.WorksheetFunction.RandBetween(FirstRow + 1, LastRow)
        Sheet1.Range("A" & CurRow).Resize(1, 2).Cut
        Sheet1.Range("A" & FirstRow).Resize(1, 2).Insert Shift:=xlShiftDown
        Sheet2.Range("A" & CurRow).Resize(1, 4).Cut
        Sheet2.Range("A" & FirstRow).Resize(1, 4).Insert Shift:=xlShiftDown
    Next Counter

[HansV]

The line

Sheet1.Range("B" & FirstRow & ":B" & LastRow).ClearContents

clears the answers on the first sheet (in case someone saved the workbook with completed answers).

The loop

For Counter = 1 To 2 * (LastRow - FirstRow + 1)
...
Next Counter

moves questions around a number of times. I used 2 * (number of questions), but anything over (number of questions) would be OK.

CurRow = Application.WorksheetFunction.RandBetween(FirstRow + 1, LastRow) uses the RANDBETWEEN worksheet function to pick a question at random between the second and last questions.

The lines

Sheet1.Range("A" & CurRow).Resize(1, 2).Cut
Sheet1.Range("A" & FirstRow).Resize(1, 2).Insert Shift:=xlShiftDown

then move the selected question up to the first question, pushing the intermediate questions down. So for example if CurRow corresponds to the 4th question, the 4th question is moved to the top, pushing questions 1, 2 and 3 down:

S279.png

The lines

Sheet2.Range("A" & CurRow).Resize(1, 4).Cut
Sheet2.Range("A" & FirstRow).Resize(1, 4).Insert Shift:=xlShiftDown

perform exactly the same action on the second sheet (but now including columns A through D). Because we move the same row to the top as on the first sheet, the two sheets remain in sync.

This is repeated, each time selecting a question at random to be pushed to the top. This shuffles the deck.

[JimmyC]

Hans--thank you for the explanation. You are truly a genius. You have been so gracious over the years to help me and I am so very thankful and appreciative of every single piece of advice you have ever provided. Again, thank you. Jim

[JimmyC]

I am learning allot from this project and I have stumbled across another issue, or at least I think it is an issue. In the sample file attached previously to this thread, I had manually entered the data validation list range in each "answer" cell on the first worksheet (i.e. it allows the users to select the correct answer from five choices). Originally this project was a "one and done" project--but given how much test scores improved, the instructor requested additional workbooks with study questions for other subjects.

The creation of the data validation list cannot be "copied" down the column and, as far as I know, it has to be manually created; Rory in post #192888 was kind enough to provide me with this formula so that I could copy down the data validation list:

You can use formulas in DV, so something like this for B5:
=INDEX($P$403:$XFD$407,0,ROW()-ROW($B$4))
and then copy and paste the DV down.

This formula has saved me 20 hours in the creation of the quiz worksheets; however, when I apply the random sort macro code now---the data validation list in the answer column no longer "matches" the question. I think what is happening, since the data validation list is now a formula, that when the random order macro runs---it does move the data validation list cells correctly---but the formula used to define the range in the data validation list is based on a sequential order and when these cells are re-arranged by the random sort macro--the data validation list cell is no longer "paired" correctly with its question (i.e. the data validation list points to a range that has different answers than the question).

I hope I have explained the issue correctly---is there a workaround or maybe I need to just manually enter each data validation list range as this approach works correctly with random sort macro. Thank you for any advice. JimC

[HansV]

See the attached version. I numbered the lists 1 to 5. You can extend this if necessary.
I added the correct numbers in C5:C9, and modified the code to move these numbers too when the questions are shuffled.
Data validation in B5 now uses the formula

=INDEX($P$403:$T$407,0,MATCH($C5,$P$402:$T$402,0))

C5 is the cell with the number corresponding to the correct validation list. Since C5 is moved with the question, the validation list remains correct.

hans_eileens_lounge_stripped_example.xlsm

[JimmyC]

Hans--you are genius! I will study your worksheet. Thank you. JimC

[JimmyC]

Hans,
I am still learning allot and still working on this project. What started as a "quick and dirty" or "a one and done" project continues to grow and become more cumbersome. I am still developing workbooks for learning review.

Most often there are too many questions for me to complete the worksheet in a single session so I end up saving the worksheet/workbook. At a later time, I return to re-open the workbook/worksheet to continue to type questions and answers. There may be 4 or 5 iterations of this cycle before the worksheet/workbook is completed. The creation process is made more difficult as the questions/answers are randomized each time the file is open. Is there any way to prompt the user whether to randomize the questions and clear the answers when the workbook opens (i.e. a yes or no choice)? That way I could say no when I am populating the worksheet/workbook but the end user could click yes.

I did successfully remove all of the code while I was developing the worksheet/workbook and this greatly assisted me in the data entry process. But I then made a mistake and forgot to copy the code back into the workbook before I e-mailed the excel file to the trainer. She was none too pleased about my error and I must have caught her on one of her more grumpy days as I received a "royal" lecture (i.e., I believe this is the politically correct terminology). So I have already cleared it with her whether a dialog box question to randomized the questions and clear the answers would be acceptable---I have received her "royal" blessing to do this if it can be done. Can your code be adjusted to include a "yes or no" prompt whether to randomize/clear answers or just leave the worksheet as-is (i.e. using the example in post 193398)?

Perhaps there is even a better way to do this task---as it truly only needs to NOT randomize for me---but randomize for everyone else that opens the workbook. Maybe instead of totally removing the code, I can change only one line, etc to disable it but I am afraid to try for fear of screwing-up the workbook---and hopefully, I remember to change it back when I e-mail the file. As mad as the trainer was at my error, a repeat offense, might get me "royally" terminated. All suggestions are welcome to overcome my shortcoming.

Again, thank you for all of your help and patience. The patience is especially appreciated as it is in short supply with many individuals most notably with our organization's grumpy trainer. Her pleasant personality is probably the main reason our employees prefer to learn using the Excel practice quiz worksheets. Thank you. JimC

[HansV]

If you hold down the Shift key when opening the workbook, the code will not run automatically.

Would that be acceptable? You wouldn't have to change anything in the workbook, just remember to hold down Shift when you open the workbook if you don't want the questions to be randomized.

If you don't like this idea, it is possible to build a prompt into the code, or to check the username.

[JimmyC]

Hans---I know have told you this before---but again, you are the BEST!!! Wow, this is great news. Thank you again. JimC