Randomize a list in Microsoft Word - vba

Question

I am a teacher and I have been making a number of multiple choice tests for students using Microsoft Word. Is there a way for me to automatically shuffle the questions so that I can have multiple versions of the test without needing to copy and paste the questions around my test?
Looking online I found a one solution posted by Steve Yandl in which he used macro after putting each question on a separate row in a table. I am trying to get his macro to work but it has and error. I know next to nothing about coding, so I am stuck. Here is his code:
Sub ShuffleQuestions()
Dim Tmax As Integer
Dim strCell As String
Dim strQ As Variant
Dim strText As String
Dim I As Integer
Dim Z As Integer
Dim intQsLeft As Integer
Dim rndQ As Integer
Dim Q As Integer
Dim vArray As Variant
Dim strNew As String
Set objDict = CreateObject("Scripting.Dictionary")
Tmax = ThisDocument.Tables(1).Rows.Count
For I = 1 To Tmax
strCell = ThisDocument.Tables(1).Cell(I, 1).Range.Text
strQ = Left(strCell, Len(strCell) - 1)
objDict.Add strQ, strQ
Next I
ReDim arrQs(I - 1)
intQsLeft = I - 2
Z = 0
Do While intQsLeft = 0
Randomize
rndQ = Int((intQsLeft + 1) * Rnd)
intQsLeft = intQsLeft - 1
vArray = objDict.Items
strText = vArray(rndQ)
arrQs(Z) = strText
Z = Z + 1
objDict.Remove strText
Loop
For Q = 1 To Tmax
strNew = arrQs(Q - 1)
strNew = Left(strNew, Len(strNew) - 1)
ThisDocument.Tables(1).Cell(Q, 1).Range.Text = strNew
Next Q
End Sub
The error message I get says "run time error 5941 the requested member of the collection does not exist"
When I choose the 'Debug' button it brings me to the line of code in the macro that says "Tmax = ThisDocument.Tables(1).Rows.Count"
Ultimately I just want to reorder the questions, but I would be delighted if there was also a way to reorder my multiple choice options for each question.

Answer 1

Does your document have a table?
Where did you put the sub (ShuffleQuestions)?
Are you sure you added it to your document and didn't add it to the document template (probably normal).
If, after running the code, reaching the error and clicking debug, you highlight ThisDocument.Tables, right clicking on the highlighted text and select "Add Watch" from the popup menu you should be able to see if ThisDocument.Tables contains any data.
I suspect it will be empty. It will be empty if:
You haven't added a table to your document
You have added the sub to normal.dot in which case ThisDocument will refer to the normal template and not the document you are actually editing.
So, the solution is either:
Make sure your sub is in the document you are editing (and not the document template)
That you have a table in your document.
There are also some programming errors in the sub ShuffleQuestions (e.g. Do While intQsLeft = 0 should be something like Do While intQsLeft > 0).
The following code works (and is a lot simpler):
Sub ShuffleQuestions()
Dim numberOfRows As Integer
Dim currentRowText As String
Dim I As Integer
Dim doc As Document
Set doc = ActiveDocument
'Find the number of rows in the first table of the document
numberOfRows = doc.Tables(1).Rows.Count
'Initialise (seed) the random number generator
Randomize
'For each row in the table
For I = 1 To numberOfRows
'Find a new row number (any row in the table)
newRow = Int(numberOfRows * Rnd + 1)
'Unless we're not moving to a new row
If newRow <> I Then
'Get the current row text
currentRowText = CleanUp(doc.Tables(1).Cell(I, 1).Range.Text)
'Overwrite the current row text with the new row text
doc.Tables(1).Cell(I, 1).Range.Text = CleanUp(doc.Tables(1).Cell(newRow, 1).Range.Text)
'Put the current row text into the new row
doc.Tables(1).Cell(newRow, 1).Range.Text = currentRowText
End If
Next I
End Sub
Function CleanUp(value As String) As String
'Remove control characters from the end of the string (the cell text has a 'BELL' character and CR at the end)
While (Len(value) > 0 And Asc(Right(value, 1)) < 32)
value = Left(value, Len(value) - 1)
Wend
CleanUp = value
End Function

Answer 2

For those who wants to randomize all the paragraphs in a document.
To make it work, put your cursor at the end of your document with no selections.
Sub ran_para()
n = ActiveDocument.Paragraphs.Count
ReDim a(1 To 2, 1 To n)
Randomize
For i = 1 To n
a(1, i) = Rnd
a(2, i) = i
Next
For i = 1 To n - 1
For j = i + 1 To n
If a(1, j) > a(1, i) Then
t = a(2, i)
a(2, i) = a(2, j)
a(2, j) = t
End If
Next
Next
'Documents.Add
For i = 1 To n
Set p = ActiveDocument.Paragraphs.Add
p.Range.Text = ActiveDocument.Paragraphs(a(2, i)).Range.Text
Next
End Sub