How to scramble tables in word

[amit81]

Hello Friends

I am working on a question bank having more than 500 questions in a word file.
For Each question a table is created with seven rows.
So for 500 questions we have created 500 tables.

I want to scramble the tables (questions) i.e. I want to randomly shuffle each table (question).

Kindly guide how to do this using VBA Macro.

[Kilroy]

I found this macro on "WordBanter.com" http://www.wordbanter.com/showthread.php?t=49126 It doesn't quite work. I posted a reply to the thread stating it didn't work. For me it only deletes the first column but I believe it can be modified.

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
      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(Q) = strText
         Z = Z + 1
          objDict.Remove strText
      Loop
      For Q = 1 To Tmax
          ThisDocument.Tables(1).Cell(Q, 1).Range.Text = arrQs(Q - 1)
      Next Q
End Sub

[amit81]

Thank you Kilroy for helping. The above code is not working and showing some kind of error.
I think the above code is for scrambling rows of a table.

I am looking for randomizing the tables in a word document.

[gmaxey]

Maybe something like this:

Option Explicit

Sub Test()
    Dim oRng As Range
    Dim lngCount As Long, lngIndex As Long
    Dim varRanNums
    lngCount = ActiveDocument.Tables.Count
    varRanNums = fcnRandomNonRepeatingNumberGenerator(1, lngCount, lngCount, False)
    For lngIndex = 1 To UBound(varRanNums)
         Set oRng = ActiveDocument.Range
         oRng.Collapse wdCollapseEnd
         oRng.InsertBefore vbCr
         oRng.Collapse wdCollapseEnd
         ActiveDocument.Tables(varRanNums(lngIndex)).Range.Copy
         oRng.Paste
    Next
    For lngIndex = lngCount To 1 Step -1
         Set oRng = ActiveDocument.Tables(lngIndex).Range
         ActiveDocument.Tables(lngIndex).Delete
         oRng.Paragraphs(1).Range.Delete
    Next
    lbl_Exit:
    Exit Sub
End Sub

Function fcnRandomNonRepeatingNumberGenerator(LowerNumber As Long, _
    UpperNumber As Long, NumRange As Long, Optional bSort As Boolean = False) As Variant
    Dim lngNumbers As Long, lngRandom As Long, lngTemp As Long
    ReDim varNumbers(LowerNumber To UpperNumber) As Variant
    Dim varRandomNumbers() As Variant       
    For lngNumbers = LowerNumber To UpperNumber
         varNumbers(lngNumbers) = lngNumbers
    Next lngNumbers
    Randomize
   For lngNumbers = 1 To NumRange
         lngRandom = Int(Rnd() * (UpperNumber - LowerNumber + 1 - (lngNumbers - 1))) + (LowerNumber + (lngNumbers - 1))
         lngTemp = varNumbers(lngRandom)
         varNumbers(lngRandom) = varNumbers(LowerNumber + lngNumbers - 1)
         varNumbers(LowerNumber + lngNumbers - 1) = lngTemp
    Next lngNumbers
    ReDim Preserve varNumbers(LowerNumber To LowerNumber + NumRange - 1)
    ReDim varRandomNumbers(1 To NumRange)
    For lngNumbers = 1 To NumRange
         varRandomNumbers(lngNumbers) = varNumbers(LBound(varNumbers) + lngNumbers - 1)
    Next lngNumbers
    If bSort = True Then
         fcnRandomNonRepeatingNumberGenerator = ArrayListSort(varRandomNumbers())
    Else
         fcnRandomNonRepeatingNumberGenerator = varRandomNumbers()
    End If
    lbl_Exit:
  Exit Function
End Function

Function ArrayListSort(varList As Variant, Optional bAscending As Boolean = True)
    Dim varLE As Variant
    With CreateObject("System.Collections.ArrayList")
         For Each varLE In varList
             .Add varLE
        Next
        .Sort 'Sort ascendending
        If bAscending = False Then .Reverse 'Sort and then Reverse to sort descending
            ArrayListSort = .Toarray()
      End With
End Function

[mana]

Option Explicit

Sub test()
    Dim dic As Object, dicDup As Object, rn As Object
    Dim doc As Document, dup As Document
    Dim k As Long, n As Long
    Dim tbl As Table
    Set dic = CreateObject("scripting.dictionary")
    Set dicDup = CreateObject("scripting.dictionary")
    Set rn = CreateObject("system.random")    
    Application.ScreenUpdating = False    
    Set doc = ActiveDocument
    Set dup = Documents.Add(doc.FullName)    
    For k = 1 To doc.Tables.Count
        Set dic(k) = doc.Tables(k)
        Set dicDup(k) = dup.Tables(k)
    Next    
    For k = 1 To dicDup.Count - 1
        n = rn.next_2(k, dicDup.Count + 1)
        Set tbl = dicDup(k)
        Set dicDup(k) = dicDup(n)
        Set dicDup(n) = tbl
    Next
    For k = 1 To dic.Count
        dicDup(k).Range.Copy
        dic(k).Range.Select
         dic(k).Delete
        Selection.Range.Paste
    Next    
     dup.Close False
End Sub

マナ

[mana]

Sub test2()
    Dim dic As Object, rn As Object
    Dim doc As Document, dup As Document
    Dim k As Long, n As Long
    Dim tbl As Table
    Set dic = CreateObject("scripting.dictionary")
    Set rn = CreateObject("system.random")    
    Application.ScreenUpdating = False    
    Set doc = ActiveDocument
    Set dup = Documents.Add(doc.FullName)    
    For k = 1 To doc.Tables.Count
        Set dic(k) = dup.Tables(k)
    Next    
    For k = 1 To dic.Count - 1
        n = rn.next_2(k, dic.Count + 1)
        Set tbl = dic(k)
        Set dic(k) = dic(n)
        Set dic(n) = tbl
    Next
    For k = 1 To dic.Count
        dic(k).Range.Copy
        doc.Tables(k).Range.Select
        doc.Tables(k).Delete
        Selection.Range.Paste
    Next    
     dup.Close False
End Sub

Umm...this is same as post #4

Sub test3()
    Dim dic As Object, rn As Object
    Dim doc As Document, dup As Document
    Dim k As Long, n As Long
    Set dic = CreateObject("scripting.dictionary")
    Set rn = CreateObject("system.random")    
    Application.ScreenUpdating = False    
    Set doc = ActiveDocument
    Set dup = Documents.Add(doc.FullName)    
    Do
        n = rn.next_2(1, doc.Tables.Count + 1)
        dic(n) = Empty
        If dic.Count = doc.Tables.Count Then Exit Do
    Loop
    For k = 1 To dic.Count
        dup.Tables(dic.keys()(k - 1)).Range.Copy
        doc.Tables(k).Range.Select
        doc.Tables(k).Delete
        Selection.Range.Paste
    Next    
     dup.Close False
End Sub

マナ

[gmaxey]

mana,

Thanks for posting. It seems we both were initially duped thinks that the tables would have to be duplicated in some manner. Turns out not to be the case. This adaptation of your dictionary and random processes is much faster:

Sub test5()
    Dim oDic As Object, oRanNumGen As Object
    Dim lngIndex As Long, lngRandom As Long
    Dim lngCount As Long
    Dim oRng As Range, oRng2 As Range
    Dim oTbls As Tables
    Set oTbls = ActiveDocument.Tables
    Set oDic = CreateObject("scripting.dictionary")
    Set oRanNumGen = CreateObject("system.random")
    Application.ScreenUpdating = False
    lngCount = oTbls.Count
    Do
         lngRandom = oRanNumGen.next_2(1, lngCount + 1)
         oDic(lngRandom) = Empty
         If oDic.Count = lngCount Then Exit Do
    Loop
    For lngIndex = 1 To oDic.Count
         Set oRng = oTbls(oDic.keys()(lngIndex - 1)).Range
         Set oRng2 = oTbls(lngIndex).Range
         If Not oRng = oRng2 Then
             oRng2.Tables(1).Delete
             oRng2.FormattedText = oRng.FormattedText
         End If
    Next
    lbl_Exit:
    Set oTbls = Nothing: Set oRng = Nothing: Set oRng2 = Nothing
    Set oDic = Nothing: Set oRanNumGen = Nothing
    Exit Sub
End Sub

Where can I read up about system.random? I found an article but it didn't include the next_2 method. Also, what does dic(n) = Empty really do?

[mana]

> but it didn't include the next_2 method


we can't use same name,even if it is different count of parameters


Please try

Sub test()
    Dim a As Object    
    Set a = CreateObject("system.collections.arraylist")    
    a.Add 1
    a.Add 2
    a.Add 3
    a.Add 4    
    MsgBox a(0)    
    a.Reverse
    MsgBox a(0)    
    ' a.Reverse 0, 2      '<---error
    a.Reverse_2 0, 2    '<---replace name with "xxx_number"
    MsgBox a(0)    
End Sub


Sub test2()
    Dim r As Object    
    Set r = CreateObject("system.random")    
    ' MsgBox r.Next(2, 10)    '<---error
    MsgBox r.Next_2(2, 10)    
    ' MsgBox r.Next(10)       '<---error
    MsgBox r.Next_3(10)    
End Sub

[mana]

> It seems we both were initially duped thinks that the tables would have to be duplicated in some manner. Turns out not to be the case.

I don't think so.
Please try document containing 3 tables.

[gmaxey]

mana,

Yes, you are correct. This should resolve that and still much faster than select, copy, paste:

Sub test5()
    Dim oDic As Object, oRanNumGen As Object
    Dim lngIndex As Long, lngRandom As Long
    Dim lngCount As Long
    Dim oRng As Range, oRng2 As Range
    Dim oTbls As Tables, oTblsDup As Tables
    Dim oDocDup As Document  
    Set oTbls = ActiveDocument.Tables
    Set oDocDup = Documents.Add(ActiveDocument.FullName)
    Set oTblsDup = oDocDup.Tables
    Set oDic = CreateObject("scripting.dictionary")
    Set oRanNumGen = CreateObject("system.random")
    Application.ScreenUpdating = False
    lngCount = oTbls.Count
    Do
         lngRandom = oRanNumGen.next_2(1, lngCount + 1)
         oDic(lngRandom) = Empty
         If oDic.Count = lngCount Then Exit Do
    Loop
    For lngIndex = 1 To oDic.Count
         Set oRng = oTblsDup(oDic.keys()(lngIndex - 1)).Range
         ' oRng.End = oRng.End + 1
         Set oRng2 = oTbls(lngIndex).Range
         oRng2.Tables(1).Delete
         oRng2.FormattedText = oRng.FormattedText
    Next
    oDocDup.Close wdDoNotSaveChanges
    lbl_Exit:
    Set oTbls = Nothing: Set oRng = Nothing: Set oRng2 = Nothing
    Set oDocDup = Nothing: oDic = Nothing: Set oRanNumGen = Nothing
    Exit Sub
End Sub

[mana]

> oRng2.FormattedText = oRng.FormattedText

Oh,thank you! I couldn't do it!
It's exactly what I wanted to know.

[Kilroy]

Greg, Mana thanks for your efforts on this one. Very interesting.

[gmaxey]

Kilroy,

Yes. It was interesting. In fact, I've played around with the concept a little and decided to start with Test Bank.docm file containing 500 (or any number of questions) and and a Test Generator template with code to generate a test with a user defined number of questions drawn randomly from the test bank.

Here is the code (for simplicity, the code required the Test Bank.docm and Test Generator.dotm files to be located in same folder).

Maybe mana will come back showing how to do the same thing with the system.random. I can't find any information for working with it to say return 100 random out of a possible 500.

Option Explicit

Sub CreateTest()
    Dim oDocBank As Document
    Dim oBankTbls As Tables
    Dim oRng As Range, oRngInsert As Range
    Dim lngCount As Long, lngIndex As Long, lngQuestions As Long
    Dim varRanNums
    Dim oFld As Field
    Set oDocBank = Documents.Open(ThisDocument.Path & "\Test Bank.docm", , , False, , , , , , , , False)
    Set oBankTbls = oDocBank.Tables
    Application.ScreenUpdating = False
    lngCount = oBankTbls.Count
    lngQuestions = CLng(InputBox("Enter the number of test questions", "NUMBER OF QUESTIONS", "100"))
    varRanNums = fcnRandomNonRepeatingNumberGenerator(1, lngCount, lngQuestions)
    Application.ScreenUpdating = False
    For lngIndex = 1 To UBound(varRanNums)
        Set oRngInsert = ActiveDocument.Bookmarks("QuestionAnchor").Range
        Set oRng = oBankTbls(varRanNums(lngIndex)).Range
        With oRngInsert
            .FormattedText = oRng.FormattedText
            .Collapse wdCollapseEnd
            .InsertBefore vbCr
            .Collapse wdCollapseEnd
       End With
       ActiveDocument.Bookmarks.Add "QuestionAnchor", oRngInsert    
    Next
    Application.ScreenUpdating = True
    For Each oFld In ActiveDocument.Fields
         If InStr(oFld.Code, "Bank") > 0 Then oFld.Unlink
    Next oFld
    ActiveDocument.Fields.Update
    oDocBank.Close wdDoNotSaveChanges
    lbl_Exit:
    Set oDocBank = Nothing: Set oBankTbls = Nothing
    Set oRng = Nothing: Set oRngInsert = Nothing: Set oFld = Nothing
    Exit Sub
End Sub


Function fcnRandomNonRepeatingNumberGenerator(LowerNumber As Long, _
    UpperNumber As Long, NumRange As Long) As Variant
    Dim lngNumbers As Long, lngRandom As Long, lngTemp As Long
    ReDim varNumbers(LowerNumber To UpperNumber) As Variant
    Dim varRandomNumbers() As Variant     
    For lngNumbers = LowerNumber To UpperNumber
         varNumbers(lngNumbers) = lngNumbers
    Next lngNumbers
    Randomize
    For lngNumbers = 1 To NumRange
         lngRandom = Int(Rnd() * (UpperNumber - LowerNumber + 1 - (lngNumbers - 1))) + (LowerNumber + (lngNumbers - 1))
         lngTemp = varNumbers(lngRandom)
         varNumbers(lngRandom) = varNumbers(LowerNumber + lngNumbers - 1)
         varNumbers(LowerNumber + lngNumbers - 1) = lngTemp
    Next lngNumbers
    ReDim Preserve varNumbers(LowerNumber To LowerNumber + NumRange - 1)
    Dim varRandomNumbers(1 To NumRange)
    For lngNumbers = 1 To NumRange
        varRandomNumbers(lngNumbers) = varNumbers(LBound(varNumbers) + lngNumbers - 1)
    Next lngNumbers
    fcnRandomNonRepeatingNumberGenerator = varRandomNumbers
    lbl_Exit:
    Exit Function
End Function

Sub ClearQuestions()
    Dim lngIndex As Long
    Dim oRng As Range
    For lngIndex = ActiveDocument.Tables.Count To 1 Step -1
        Set oRng = ActiveDocument.Tables(lngIndex).Range.Paragraphs(1).Range
        ActiveDocument.Tables(lngIndex).Delete
        oRng.Delete
    Next
End Sub

[gmaxey]

Actually, it was easier than I expected:

Sub CreateTest()
    Dim oDocBank As Document
    Dim oBankTbls As Tables
    Dim oDic As Object, oRanNumGen As Object
    Dim oRng As Range, oRngInsert As Range
    Dim lngIndex As Long, lngQuestions As Long
    Dim oFld As Field
    Set oDocBank = Documents.Open(ThisDocument.Path & "\Test Bank.docm", , , False, , , , , , , , False)
    Set oBankTbls = oDocBank.Tables
    Set oDic = CreateObject("scripting.dictionary")
    Set oRanNumGen = CreateObject("system.random")
    lngQuestions = CLng(InputBox("Enter the number of test questions", "NUMBER OF QUESTIONS", "100"))
    Do
         lngIndex = oRanNumGen.next_2(1, oBankTbls.Count)
         oDic(lngIndex) = Empty
         If oDic.Count = lngQuestions Then Exit Do
    Loop
    Application.ScreenUpdating = False
    For lngIndex = 1 To oDic.Count
         Set oRngInsert = ActiveDocument.Bookmarks("QuestionAnchor").Range
         Set oRng = oBankTbls(oDic.keys()(lngIndex - 1)).Range
         With oRngInsert
             .FormattedText = oRng.FormattedText
             .Collapse wdCollapseEnd
             .InsertBefore vbCr
             .Collapse wdCollapseEnd
       End With
       ActiveDocument.Bookmarks.Add "QuestionAnchor", oRngInsert
  Next
  For Each oFld In ActiveDocument.Fields
      ' Unlink the sequention question bank number field.
      If InStr(oFld.Code, "Bank") > 0 Then oFld.Unlink
  Next oFld
    ' Update the sequential question number field.
    ActiveDocument.Fields.Update
    Application.ScreenUpdating = True
    oDocBank.Close wdDoNotSaveChanges
    lbl_Exit:
    Set oDic = Nothing: Set oRanNumGen = Nothing
    Set oDocBank = Nothing: Set oBankTbls = Nothing
    Set oRng = Nothing: Set oRngInsert = Nothing: Set oFld = Nothing
    Exit Sub
End Sub

[Kilroy]

Greg Thankyou so much for your efforts. The “next_2” wasn’t something I heard of. As you know I’ve been learning part time for a couple of years only. I was trying to read a bit about it and couldn’t really find much of an explanation for a layman other than:
Next method:Returns a random number greater than or equal to 0.
Next_2method: Returns a random number within the specified range.
Next_3method: Returns a random number greater than or equal to 0 that is less thanthe specified maximum value.
NextDoublemethod: Returns a random number between 0.0 and 1.0.


I’ll be honest I still don’t really understand it enough to try and work with it. I’m wondering if the choosing of the questions could be based on the sections of the document instead of all tables in the document? So if I added questions in 20 sections could this work to randomly take a number of questions from each section? So if I entered 100in the input box could it go and take 5 questions randomly from each of the 20 sections?If it could I suppose there would need to be a handler of some sort in case there was less than the average calculated to take from each section like for example: “If section X has less than the 100\20 then add the difference to other sections so the total is still 100 questions”?

[gmaxey]

Kilroy,

Thanks for that. Well, I took the test bank I posted the other day and divided it into 5 sections with 100 tables (questions) per section. Then using this revised code, I was able to generate a 100 question test with 20 questions from each section:

Sub CreateTestAdv()
    Dim oDocBank As Document
    Dim oBankTbls As Tables
    Dim oDic As Object, oRanNumGen As Object
    Dim oRng As Range, oRngInsert As Range
    Dim lngIndex As Long, lngQuestions As Long
    Dim oFld As Field
    Dim lngSec As Long, lngLow As Long, lngHigh As Long  
    ' Open the test bank document. The test bank document consists of five sections with 100 questions defined in 100 tables per section.
    Set oDocBank = Documents.Open(ThisDocument.Path & "\Test Bank.docm", , , False, , , , , , , , False)
    ' Iniitalize a dictionary and random number generator object.
    Set oDic = CreateObject("scripting.dictionary")
    Set oRanNumGen = CreateObject("system.random")
    lngQuestions = CLng(InputBox("Enter the number of test questions", "NUMBER OF QUESTIONS", "100"))
    For lngSec = 1 To oDocBank.Sections.Count
         Set oBankTbls = oDocBank.Sections(lngSec).Range.Tables
         Set oRng = oDocBank.Range
         oRng.End = oBankTbls.Item(1).Range.Start
         lngLow = oRng.Tables.Count
         If lngLow > 1 Then lngLow = lngLow + 1
         Set oRng = oDocBank.Range
         oRng.End = oBankTbls.Item(oBankTbls.Count).Range.End
         lngHigh = oRng.Tables.Count
    Do
         lngIndex = oRanNumGen.next_2(lngLow, lngHigh)
        oDic(lngIndex) = Empty
        If oDic.Count = lngQuestions Then Exit Do
        If lngQuestions / oDic.Count = oDocBank.Sections.Count / lngSec Then Exit Do
    Loop
    Next lngSec
    Application.ScreenUpdating = False
    Set oBankTbls = oDocBank.Tables
    For lngIndex = 1 To oDic.Count
         Set oRngInsert = ActiveDocument.Bookmarks("QuestionAnchor").Range
         Set oRng = oBankTbls(oDic.keys()(lngIndex - 1)).Range
         With oRngInsert
             .FormattedText = oRng.FormattedText
             .Collapse wdCollapseEnd
             .InsertBefore vbCr
             .Collapse wdCollapseEnd
        End With
        ActiveDocument.Bookmarks.Add "QuestionAnchor", oRngInsert
    Next
    Application.ScreenUpdating = True
    For Each oFld In ActiveDocument.Fields
         ' Unlink the sequention question bank number field.
         If InStr(oFld.Code, "Bank") > 0 Then oFld.Unlink
     Next oFld
     ' Update the sequential question number field.
     ActiveDocument.Fields.Update
     oDocBank.Close wdDoNotSaveChanges
     lbl_Exit:
    Set oDic = Nothing: Set oRanNumGen = Nothing
    Set oDocBank = Nothing: Set oBankTbls = Nothing
    Set oRng = Nothing: Set oRngInsert = Nothing: Set oFld = Nothing
    Exit Sub
End Sub

There would need to be some extensive revisions to prevent errors. For example, you can't create a 500 question exam or a say a 13 question exam, but 100, 50, 25, 10 etc. are possible.

[Paul_Hossler]

Interesting, esp the part about System. I'll have to learn some more about that

Couple of comments (I think I did it right)

1. Changed one line

    'Open the test bank document. The test bank document consists of five sections with 100 questions defined in 100 tables per section.
    Set oDocBank = Documents.Open(ActiveDocument.Path & "\Test Bank.docm", , , False, , , , , , , , False)

2. Added 2 References (System and Scripting). I was surprised they weren't referenced automatically (Late binding??)

3. If you wanted to 'polish' some more

a. you could write the selected test questions to a third macro-less docx (leave the 'master' docm as it) which was formatted for each class, semester, prof name, etc.
b. Add ability for different TestBank.docm to be selected and used

[Kilroy]

Ok my test bank document is 250 questions, 12 sections and I chose 25 questions. I'm getting an infinite loop:

 Do
      lngIndex = oRanNumGen.next_2(lngLow, lngHigh)
      oDic(lngIndex) = Empty
      If oDic.Count = lngQuestions Then Exit Do
      If lngQuestions / oDic.Count = oDocBank.Sections.Count / lngSec Then Exit Do
    Loop

Update: I've changed the mount of questions in test bank and sections and tried different amounts of questions for the exam page and nothing has changed. Still in infinite loop

[gmaxey]

Kilroy,

In my example, this condition:
If lngQuestions / oDic.Count = oDocBank.Sections.Count / lngSec Then Exit Do

was met after 20 random numbers were selected from 1-100, 40 random numbers 101-200 etc. So after all five section were processed 100 random numbers have been selected 1-500.

In your case the defined conditions are not met. I think if you tried for 24 questions then it might work.

[gmaxey]

Kilroy,

Try this. I think in your case you will get 2 questions from sections 1-11 and 3 questions from section 12.

Sub CreateTestAdv()
Dim oDocBank As Document
Dim oBankTbls As Tables
Dim oDic As Object, oRanNumGen As Object
Dim oRng As Range, oRngInsert As Range
Dim lngIndex As Long, lngQuestions As Long
Dim oFld As Field
Dim lngSec As Long, lngLow As Long, lngHigh As Long
Dim lngPerBank As Long, lngLastBank As Long
  'Open the test bank document. The test bank document consists of five sections with 100 questions defined in 100 tables per section.
  Set oDocBank = Documents.Open(ThisDocument.Path & "\Test Bank.docm", , , False, , , , , , , , False)
  'Iniitalize a dictionary and random number generator object.
  Set oDic = CreateObject("scripting.dictionary")
  Set oRanNumGen = CreateObject("system.random")
  lngQuestions = CLng(InputBox("Enter the number of test questions", "NUMBER OF QUESTIONS", "100"))
  If lngQuestions / oDocBank.Sections.Count - Int(lngQuestions / oDocBank.Sections.Count) > 0.5 Then
    lngPerBank = (lngQuestions \ oDocBank.Sections.Count) + 1
  Else
    lngPerBank = lngQuestions \ oDocBank.Sections.Count
  End If
  lngLastBank = lngQuestions - (lngPerBank * (oDocBank.Sections.Count - 1))
  For lngSec = 1 To oDocBank.Sections.Count
    Set oBankTbls = oDocBank.Sections(lngSec).Range.Tables
    Set oRng = oDocBank.Range
    oRng.End = oBankTbls.Item(1).Range.Start
    lngLow = oRng.Tables.Count
    If lngLow > 1 Then lngLow = lngLow + 1
    Set oRng = oDocBank.Range
    oRng.End = oBankTbls.Item(oBankTbls.Count).Range.End
    lngHigh = oRng.Tables.Count
    Do
      lngIndex = oRanNumGen.next_2(lngLow, lngHigh)
      oDic(lngIndex) = Empty
      If lngSec < oDocBank.Sections.Count Then
        If oDic.Count = lngPerBank * lngSec Then Exit Do
      Else
        If oDic.Count = lngQuestions Then Exit Do
      End If
    Loop
  Next lngSec
  Stop
  Application.ScreenUpdating = False
  Set oBankTbls = oDocBank.Tables
  For lngIndex = 1 To oDic.Count
    Set oRngInsert = ActiveDocument.Bookmarks("QuestionAnchor").Range
    Set oRng = oBankTbls(oDic.keys()(lngIndex - 1)).Range
    With oRngInsert
      .FormattedText = oRng.FormattedText
      .Collapse wdCollapseEnd
      .InsertBefore vbCr
      .Collapse wdCollapseEnd
    End With
    ActiveDocument.Bookmarks.Add "QuestionAnchor", oRngInsert
  Next
  Application.ScreenUpdating = True
  For Each oFld In ActiveDocument.Fields
    'Unlink the sequention question bank number field.
    If InStr(oFld.Code, "Bank") > 0 Then oFld.Unlink
  Next oFld
  'Update the sequential question number field.
  ActiveDocument.Fields.Update
  oDocBank.Close wdDoNotSaveChanges
lbl_Exit:
  Set oDic = Nothing: Set oRanNumGen = Nothing
  Set oDocBank = Nothing: Set oBankTbls = Nothing
  Set oRng = Nothing: Set oRngInsert = Nothing: Set oFld = Nothing
  Exit Sub
End Sub