mana,

Thanks. I see now that: 'Next_2method: Returns a random number within the specified range. Is not really true
lngIndex = oRanNumGen.next_2(1, 10) would return numbers 1-9 to return 1-10 you need (1, 11). That does seem a bit odd.




There was a also a typo on this line in the above code:
If oDocBank.Sections(oDocBank.Sections.Count).Range.Tables.Count > lngLastBank Then


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
Dim bEnough As Boolean
  '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 250.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.3 Then
    lngPerBank = (lngQuestions \ oDocBank.Sections.Count) + 1
  Else
    lngPerBank = lngQuestions \ oDocBank.Sections.Count
  End If
  lngLastBank = lngQuestions - (lngPerBank * (oDocBank.Sections.Count - 1))
  bEnough = True
  For lngSec = 1 To oDocBank.Sections.Count - 1
    If oDocBank.Sections(lngSec).Range.Tables.Count < lngPerBank Then
      bEnough = False
      Exit For
    End If
  Next lngSec
  If oDocBank.Sections(oDocBank.Sections.Count).Range.Tables.Count < lngLastBank Then
    bEnough = False
  End If
  If bEnough Then
    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 + 1)
        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
    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
  Else
    MsgBox "There are not enough questions in one or more sections of the test bank document to create the test define."
  End If
  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