How to scramble tables in word

[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.