TRIFECTA (or Userform Diminishing List)

I enjoy tinkering with Userforms and exploring their many capabilities. In this Microsoft Word Tips & Microsoft Word Help page I will show you how to populate a series of cascading linked Userform ComboBoxes using data from an external Word list. When a list entry is selected selected in the primary Comboboxes it is removed and no longer available in the subordinate cascading ComboBoxes.

This method creates a "diminishing list" effect and can be employed where users are required to pick and enumerate their top choices from a list.

Place your bets!! As a practical example let's create a Userform for placing a bet on the Trifecta.

The Userform consists of three ComboBoxes where the users selects their choice for Win, Place, and Show, a TextBox for entering the bet amount, and command buttons for either placing the bet or canceling the form.

The data for populating the ComboBoxes is imported from a table in external Word document like the one shown below.

For more of populating Userform ListBoxes and ComboBoxes see my: Populate Userform ListBox

When the Userform is initialized:

VBA code is used to populate the first ComboBox (Win) in the Userform with horse and jockey name information from the external table.
ComboBox ColumnCount and ColumnWidths properties are used to set the appropriate display.
When the user makes a selection in the Win ComboBox, CombBox2 (Place) is enabled and populated with horse and jockey names excluding that selection made in the Win ComboBox.
This prevents a user from selecting the same horse and jockey to both Win and Place.
The same process is repeated to populate ComboBox3 (Show) when the user makes a selection in the Place ComboBox.

The "Place Bet" command button is enabled only after the user selects a horse to win, place, and show; and enters a valid bet.

Information from the Userform is transferred to a bet slip (Word document) where it can be printed and delivered to a local bookie.

The VBA coding for diminishing items from a list is a little complex.

Basically we start by querying the source document and loading all of the horse and jockey information into a two dimensional array. The source document is then closed and the array information is used to populate a collection object with horse names and a collection object with jockey names. The collection objects are then used to populate the Win ComboBox.
When a Win selection is made we then empty the collections, recreate the complete collections, then evaluate each member of the collections and remove the members that match the selected horse and jockey name in the Win ComboBox. The revised collections are used to populate the Place ComboBox.
When a Place selection is made we repeat the process above to remove the Win and Place selections from the collections. The revised collections are used to populate the Show ComboBox.

The complete Userform code is provided below.

Note: Be sure to change the DataSourcePath (line 8) to reflect the location of your data table.

VBA Script:

Copy to clipboard

Option Explicit
'Declare Form level variables
Private myColHorse As Collection 'A collection for storing horse names
Private myColJockey As Collection 'A collection for storing jockey names
Private arrTrifectaData() As Variant 'An array for collecting data from the external Word document
Private i As Long
Private oCtrs As Controls
Const DataSourcePath As String = "D:\Data Stores\" 'Path for DataSheet.doc containing horse and jockey names

Sub Userform_Initialize()
Dim Source As Word.Document
Dim j As Long, m As Long, n As Long
Dim Data As Word.Range
  Application.ScreenUpdating = False
  'Open the document containing the table with horse and jockey names
  Set Source = Documents.Open(FileName:=DataSourcePath & "DataSheet.doc", Visible:=False)
  'Determine the number of rows in the table
  i = Source.Tables(1).Rows.Count
  j = Source.Tables(1).Columns.Count
  'Define the ComboBox properties
  ComboBox1.ColumnCount = j
  ComboBox1.ColumnWidths = "90;65"
  ComboBox2.ColumnCount = j
  ComboBox2.ColumnWidths = "90;65"
  ComboBox3.ColumnCount = j
  ComboBox3.ColumnWidths = "90;65"
  'Prepare the array for receiving data
  ReDim arrTrifectaData(i - 2, j - 1) '-2 is used to exclude the heading row
  'Load data from table into the two-dimensional array
  For n = 0 To j - 1
    For m = 0 To i - 2
      'Get the cell content
      Set Data = Source.Tables(1).Cell(m + 2, n + 1).Range
      'Strip the end of cell marker
      Data.End = Data.End - 1
      'Put data in array
      arrTrifectaData(m, n) = Data.Text
    Next m
  Next n
  'Close source document
  Source.Close wdDoNotSaveChanges
  Set Source = Nothing
  Set oCtrs = Me.Controls
  'Build the collections
  PopulateCollections
  With Me.ComboBox1
    .AddItem "[Select horse to win]"
    .ListIndex = 0
  End With
  'Enable ComboBox 1
  EnableExhibits 1
  'Disable ComboBoxes 2 and 3
  DisableExhibits 2
  DisableExhibits 3
  'Load ComboBox1 with data from collections
  For i = 1 To myColHorse.Count
    With Me.ComboBox1
     .AddItem
     .Column(0, i) = myColHorse(i)
     .Column(1, i) = myColJockey(i)
    End With
  Next i
  Me.btnOK.Enabled = False
lbl_Exit:
  Exit Sub
End Sub

'The following code is used to build (populate the collections). 
'The same data is used for both the collection item and key. This facilitates removing items by key in later code.
Sub PopulateCollections()
  Set myColHorse = New Collection
  Set myColJockey = New Collection
  'Add items (and key) to collections
  For i = 1 To UBound(arrTrifectaData, 1) + 1
    'repeated for item and key.
    myColHorse.Add arrTrifectaData(i - 1, 0), arrTrifectaData(i - 1, 0)
    'repeated for item and key.
    myColJockey.Add " - " & arrTrifectaData(i - 1, 1), " - " & arrTrifectaData(i - 1, 1) 
  Next i
lbl_Exit:
  Exit Sub
End Sub

'The following series of procedures is used to redefine the collections diminished by items previously selected, control the state of certain controls, and for data validation. 
Sub ComboBox1_Change()
  'Calls and passes arguments to to a common procedure
  CommonCBChange Me.ComboBox1, 2
lbl_Exit:
  Exit Sub
End Sub

Sub ComboBox2_Change()
  'Calls and passes arguments to to a common procedure
  If Me.ComboBox2.Enabled Then CommonCBChange Me.ComboBox2, 3
lbl_Exit:
  Exit Sub
End Sub

Sub ComboBox3_Change()
  'Validation to enable "Place Bet"
  If Me.ComboBox3.Enabled And Me.ComboBox3.ListIndex > 0 And IsNumeric(Me.txtBet) Then
    Me.btnOK.Enabled = True
  Else
    Me.btnOK.Enabled = False
  End If
lbl_ExitL:
  Exit Sub
End Sub

Sub CommonCBChange(ByRef oCB As ComboBox, oCBIdx As Long)
Dim myIdx As Long
'Call procedure to rebuild collections stripped of items selected in previous ComboBoxes
  CollectionRepopulate oCBIdx
  If oCB.ListIndex > 0 Then
    EnableExhibits oCBIdx
    With oCtrs("ComboBox" & oCBIdx)
      Select Case oCBIdx
        Case 2
          .AddItem "[Select horse to place]"
        Case 3
          .AddItem "[Select horse to show]"
      End Select
      'Populate ComboBox with diminished list 
      For i = 1 To myColHorse.Count
        .AddItem
        .Column(0, i) = myColHorse(i)
        .Column(1, i) = myColJockey(i)
      Next i
      .ListIndex = 0
      myIdx = oCBIdx - 1
    End With
  Else
    DisableExhibits oCBIdx
  End If
lbl_Exit:
  Exit Sub
End Sub

Sub CollectionRepopulate(ByRef x As Long)
  'Empty the collections
  For i = myColHorse.Count To 1 Step -1
    myColHorse.Remove i
  Next i
  For i = myColJockey.Count To 1 Step -1
    myColJockey.Remove i
  Next i
  'Restore the original collections
  PopulateCollections
  'Remove the items that are already selected in a higher level combobox
  For i = 1 To x - 1
    'The value may be "[Select ....]." That value is never a member of the collection
    'so error handling is used to skip the error attempting to remove that value will cause.
    On Error Resume Next'Must correspond to the key argument specified when the member was added to the collection.
    myColHorse.Remove oCtrs("ComboBox" & i).Column(0, oCtrs("ComboBox" & i).ListIndex)
    myColJockey.Remove oCtrs("ComboBox" & i).Column(1, oCtrs("ComboBox" & i).ListIndex)
    On Error GoTo 0
  Next i
  oCtrs("ComboBox" & x).Clear
lbl_Exit:
  Exit Sub
End Sub

Private Sub txtBet_Change()
  If IsNumeric(Me.txtBet) Then
    Me.lblAdvisory = " "
    Me.btnOK.Enabled = True
  Else
    Me.btnOK.Enabled = False
    End If
lbl_Exit:
  Exit Sub
End Sub

Private Sub txtBet_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  If Not IsNumeric(Me.txtBet.Text) Then
    Cancel = True
    'Display advisory label
    Me.lblAdvisory = "Enter a valid numerical value"
  End If
  With Me.txtBet
    .SelStart = 0
    .SelLength = Len(.Text)
  End With
lbl_Exit:
  Exit Sub
End Sub

'The advisory label is used to indicate an invalid data entry.

'The final bit of code is used to process the Userform and populate bookmarks in the document.
Sub btnOK_Click()
Dim oBms As Bookmarks
  Set oBms = ActiveDocument.Bookmarks
  oBms("Win").Range.InsertBefore Me.ComboBox1.Column(0)
  oBms("JWin").Range.InsertBefore Me.ComboBox1.Column(1)
  oBms("Place").Range.InsertBefore Me.ComboBox2.Column(0)
  oBms("JPlace").Range.InsertBefore Me.ComboBox2.Column(1)
  oBms("Show").Range.InsertBefore Me.ComboBox3.Column(0)
  oBms("JShow").Range.InsertBefore Me.ComboBox3.Column(1)
  oBms("Bet").Range.InsertBefore "$" & Format(Me.txtBet, "##,##0.00")
  Me.Hide
lbl_Exit:
  Exit Sub
End Sub

Sub btnCancel_Click()
  Me.Hide
lbl_Exit:
  Exit Sub
End Sub

You can call the form each time you need to create a bet slip using an AutoNew macro stored in a standard VB module.

VBA Script:

Copy to clipboard

Sub AutoNew()
Dim oFrm As myForm
  Set oFrm = New myForm
  oFrm.Show
  Unload oFrm
  Set oFrm = Nothing
lbl_Exit:
  Exit Sub
End Sub

This concludes this Tips Page. I hope that it gives you a better understanding and appreciation for Userforms. For more information on creating and employing a Userform see my: Create and Employ a Userform.

You can download the datasheet document and betting form template containing the Userform here: Trifecta File Package.

	Enter your search terms Submit search form
	Web gregmaxey.com

TRIFECTA (or Userform Diminishing List)(A Microsoft Word Help & Tip page by Gregory K. Maxey)

TRIFECTA (or Userform Diminishing List)
(A Microsoft Word Help & Tip page by Gregory K. Maxey)