How to scramble tables in word

[gmaxey]

Gents,

Yes. Like a dog with a bone, I can't let it go

mana, I ran your code with my 250 question bank split in 12 sections (20 in sections 1-11 and 10 in section 12). Using your logic, I got the not enough questions alert when I asked for a test of 150 questions. I can see that there is practically unlimited number of possibilities for section count and questions per section so I just tried to write something that would work for that case. What I've done is attempt to resolve a mix of questions from each section until the total requested is met. I'm not that proficient with a dictionary so I used an array.

Kilroy, as defined, wouldn't your test bank have 482 question if section 1 only has 2 questions ?
Can you test with your bank and see what results you get:

Sub CreateTestAdv2()
Dim oDocBank As Document
Dim oBankTbls As Tables
Dim oDic As Object, oRanNumGen As Object
Dim lngIndex As Long, lngQuestions As Long
Dim lngSecCount As Long
Dim lngLow As Long, lngHigh As Long
Dim lngPerBank As Long, lngRandom As Long, lngCheck As Long
Dim lngCumulative As Long
Dim arrPerSection()
Dim oRng As Range, oRngInsert As Range
Dim oFld As Field

  ClearQuestions
  'Open the test bank document.
  Set oDocBank = Documents.Open(ThisDocument.Path & "\Test Bank 250.docm", , , False, , , , , , , , False)
  'Iniitalize a dictionary and random number generator object.
  Set oDic = CreateObject("scripting.dictionary")
  Set oRanNumGen = CreateObject("system.random")
  'Get the number of questions.
  lngQuestions = CLng(InputBox("Enter the number of test questions", "NUMBER OF QUESTIONS", "100"))
  If lngQuestions > oDocBank.Tables.Count Then
    MsgBox "There is not enough questions in the test bank to generate the defined test.", vbInformation + vbOKOnly, "TEST SIZE TOO LARGE FOR BANK"
    GoTo lbl_Exit
  End If
  lngSecCount = oDocBank.Sections.Count
  'Develop and store the number of questions to take from each section.
  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
  ReDim arrPerSection(1 To lngSecCount)
  For lngIndex = 1 To lngSecCount
    If oDocBank.Sections(lngIndex).Range.Tables.Count > lngPerBank Then
      arrPerSection(lngIndex) = lngPerBank
    Else
      arrPerSection(lngIndex) = oDocBank.Sections(lngIndex).Range.Tables.Count
    End If
  Next
  Do
    'Check and resolve questions per section until correct total is achieved.
    lngCheck = 0
    For lngIndex = 1 To UBound(arrPerSection)
      lngCheck = lngCheck + arrPerSection(lngIndex)
    Next
    Select Case True
      Case lngCheck > lngQuestions
        lngRandom = oRanNumGen.next_2(1, lngSecCount + 1)
        If arrPerSection(lngRandom) > 1 Then
          arrPerSection(lngRandom) = arrPerSection(lngRandom) - 1
        End If
      Case lngCheck < lngQuestions
        lngRandom = oRanNumGen.next_2(1, lngSecCount + 1)
        If oDocBank.Sections(lngRandom).Range.Tables.Count > arrPerSection(lngRandom) Then
          arrPerSection(lngRandom) = arrPerSection(lngRandom) + 1
        End If
      Case Else
        Exit Do
    End Select
  Loop
  'Get the random questions from each section.
  For lngIndex = 1 To UBound(arrPerSection)
    lngCumulative = lngCumulative + arrPerSection(lngIndex)
    Set oBankTbls = oDocBank.Sections(lngIndex).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
      lngRandom = oRanNumGen.next_2(lngLow, lngHigh + 1)
      oDic(lngRandom) = Empty
      If oDic.Count = lngCumulative Then Exit Do
      If oDic.Count = lngQuestions Then Exit Do
    Loop
  Next lngIndex
  Application.ScreenUpdating = False
  Set oBankTbls = oDocBank.Tables
  'Replicate the question bank random questions in the active document.
  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 sequential question bank number field.
    If InStr(oFld.Code, "Bank") > 0 Then oFld.Unlink
  Next oFld
  'Update the sequential question number field.
  ActiveDocument.Fields.Update
lbl_Exit:
  oDocBank.Close wdDoNotSaveChanges
  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

Hmm. Thoughts after posting:
1. Maybe something to ensure that that question per section is never reduced to 0 would be the next thing ;-). Fixed in code above
2. Maybe a dialog to pick the test bank.