Resting Anchor

The Anchorage

Personal website of Gregory K. Maxey, Commander USN (Retired)

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

DISCLAIMER/TERMS OF USE

The information, illustrations and code contained in my "Microsoft Word Tips" are provided free and without risk or obligation.

Click to acces PayPal Verification Service Click to acces PayPal Verification Service

However, the work is mine. If you use it for commercial purposes or benefit from my efforts through income earned or time saved then a donation, however small, will help to ensure the continued availability of this resource.

If you would like to donate, please use the appropriate donate button to access PayPal. Thank you!

Click to donate British Pound Sterling                   Click to donate US dollars                   Click to donate EU euros

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.

trifecta 1

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

trifecta 2

Site Note IconFor more of populating Userform ListBoxes and ComboBoxes see my: Populate Userform ListBox

When the Userform is initialized:

trifecta 3

trifecta 4

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

trifecta 5

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

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

trifecta 6

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

The complete Userform code is provided below.

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

VBA Script:
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:
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.

Share

DISCLAIMER/TERMS OF USE

The information, illustrations and code contained in my "Microsoft Word Tips" are provided free and without risk or obligation.

Click to acces PayPal Verification Service Click to acces PayPal Verification Service

However, the work is mine. If you use it for commercial purposes or benefit from my efforts through income earned or time saved then a donation, however small, will help to ensure the continued availability of this resource.

If you would like to donate, please use the appropriate donate button to access PayPal. Thank you!

Click to donate British Pound Sterling                   Click to donate US dollars                   Click to donate EU euros

Search my site or the web using Google Search Engine

Google Search Logo