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