Adding 2 Commandbarcombboxes - not working

[FrustratedPgmr]

I am trying to add 2 combo boxes to a toolbar. I get the combo boxes created but the second combo box just "dings" when I click on it.

The comboboxes are 1(PatName)
(Findrowinactivecontrol3 function finds the current record based on the name)

and 2(PatSSN)
(findrowinactivecontrol4 function finds the current record based on the ssn number)

I want to set the current record to the name or the ssn depending on which one I click.

The first box works fine the second doesn't load the ssn# data and only dings when I click on it.

******************************************************
create the commandbar called "Patients"
*******************************************************
Option Compare Database
Option Explicit

Private mcolFound As Collection

Dim rst As DAO.Recordset

Dim cbr As CommandBar
Dim ctl As CommandBarControl

'Delete the toolbar if it exists and recreate with new records in dropdown box
For Each cbr In Application.CommandBars

If cbr.Name = "Patients" Then
cbr.Delete
End If
Next cbr

' Create the new commandbar.
Set cbr = CommandBars.Add("Patients", Position:=msoBarTop, Temporary:=True)
cbr.Visible = True
cbr.Protection = msoBarNoMove

Set ctl = cbr.Controls.Add(Type:=msoControlDropdown, before:=1)

With ctl
.Tag = "PatientID"
.Caption = "Select Patient &Lastname:"
.style = msoComboLabel
' Use the default width for the dropdown.
.DropDownWidth = -1

Set rst = Forms!frmPT.RecordsetClone
Do While Not rst.EOF
.AddItem rst("PatName&quot
rst.MoveNext
Loop
' Although you could specify
' the OnAction property here,
' you can use WithEvents to
' trap the events of the combo box
' instead. This allows you more
' flexibility.
.OnAction = "FindRowInActiveControl3"
End With

Set ctl = cbr.Controls.Add(Type:=msoControlDropdown, before:=2)

With ctl
.Tag = "PatientSS"
.Caption = "Select Social Sec:"
.style = msoComboLabel
' Use the default width for the dropdown.
.DropDownWidth = -1

Set rst = Forms!frmPT.RecordsetClone
Do While Not rst.EOF
.AddItem rst("PatSS&quot
rst.MoveNext
Loop
' Although you could specify
' the OnAction property here,
' you can use WithEvents to
' trap the events of the combo box
' instead. This allows you more
' flexibility.
.OnAction = "FindRowInActiveControl4"
End With

Set ctl = cbr.Controls.Add(Type:=msoControlButton)

With ctl
.BeginGroup = True
.Caption = "&Help"
.style = msoButtonCaption
.OnAction = "OpnPatHelp"
End With

Set ctl = cbr.Controls.Add(Type:=msoControlButton)

With ctl
.BeginGroup = True
.Caption = "&Exit"
.style = msoButtonCaption
.OnAction = "PatClose"
End With

End Function

********************************************
*Functions used by the commandbar "Patients"
********************************************

Public Function FindRowInActiveControl3()
' Function called from the OnAction property of the

' frmPT commandbar.

' Recordsets behind forms in MDB files
' must be DAO recordsets, not ADO.
Dim rst As DAO.Recordset
Dim strID As String
Dim cbc As CommandBarComboBox

Set cbc = CommandBars.ActionControl
strID = cbc.Text
If Len(strID) > 0 Then
With Forms!frmPT
'With Screen.ActiveForm
Set rst = Forms!frmPT.RecordsetClone
rst.FindFirst "PatName = " & FixQuotes(strID)
'rst.FindFirst "LastName = " & FixQuotes(strID)
If Not rst.NoMatch Then
.Bookmark = rst.Bookmark
Call AddToListHeader(cbc)
End If
cbc.ListIndex = 0
End With
End If

End Function
Public Function FindRowInActiveControl4()
' Function called from the OnAction property of the frmPT
' commandbar.

' Recordsets behind forms in MDB files
' must be DAO recordsets, not ADO.
Dim rst As DAO.Recordset
Dim strID As String
Dim cbc As CommandBarComboBox

Set cbc = CommandBars.ActionControl
strID = cbc.Text
If Len(strID) > 0 Then
With Forms!frmPT
'With Screen.ActiveForm
Set rst = Forms!frmPT.RecordsetClone
rst.FindFirst "PatSS = " & FixQuotes(strID)
'rst.FindFirst "LastName = " & FixQuotes(strID)
If Not rst.NoMatch Then
.Bookmark = rst.Bookmark
Call AddToListHeader(cbc)
End If
cbc.ListIndex = 0
End With
End If

End Function

******************************************************
*adds your selection to the top of the combo box list
******************************************************

Private Function AddToListHeader( _
cbc As CommandBarComboBox) As Boolean

' Add item to the header of the list if it's
' not already there, and return True if the
' item got added.

On Error Resume Next
Dim strID As String

' If this is the first time through here,
' you'll need to instantiate this Collection object.
If mcolFound Is Nothing Then
Set mcolFound = New Collection
End If

' Get the selected text and
' add it to the internal collection of values.
' If it's already in the list, Err.Number
' will be non-zero.
strID = cbc.Text
mcolFound.Add strID, Key:=strID

' Yes, this code should be smarter about errors.
' It's only example code!
If err.Number <> 0 Then
AddToListHeader = False
Else
' Add the ID to the combo box on the command bar.
' Always add it at the top of the list.
Call cbc.AddItem(strID, 1)

' The ListHeaderCount will be -1 the first time
' you come through here, indicating no divider
' line at all. If ListHeaderCount is 0, you
' have a divider line with nothing above it.
' This code either increments the value of the
' property, or sets it to be 1 in the first place.
If cbc.ListHeaderCount > 0 Then
cbc.ListHeaderCount = cbc.ListHeaderCount + 1
Else
cbc.ListHeaderCount = 1
End If
AddToListHeader = True
End If
End Function
**********************************************************

Private Function FixQuotes(varValue As Variant)
' Double any quotes inside varValue, and
' surround it with quotes.

' From Access 2002 Desktop Developer's Handbook
' by Litwin, Getz, Gunderloy (Sybex)
' Copyright 2001. All rights reserved.

FixQuotes = &quot;'&quot; & Replace$(varValue & &quot;&quot;, &quot;'&quot;, &quot;''&quot;, Compare:=vbTextCompare) & &quot;'&quot;
End Function

*********************************************************
Public Sub ClearCollection()
Set mcolFound = Nothing
End Sub

 

[SBendBuckeye]

Hello,

My guess is that somehow your 2nd combobox is not populating properly so there is nothing in it so it cannot open. Kick you code into single step mode and verify that it has data in it, etc. Good Luck!

Have a great day!

j2consulting@yahoo.com

 

[FrustratedPgmr]

I finally figured it out.

Function NewToolBar()

' Note that a form's recordset
' is a DAO recordset, in an MDB.
Dim db As DAO.Database
Dim rst As DAO.Recordset
'Had to add a second recordset with an sql statement
Dim rst2 As DAO.Recordset
Dim cbr As CommandBar
Dim ctl As CommandBarControl

'Delete the toolbar if it exists and recreate with new records in dropdown box
For Each cbr In Application.CommandBars

If cbr.Name = &quot;Patients&quot; Then
cbr.Delete
End If
Next cbr

' Create the new commandbar.
Set cbr = CommandBars.Add(&quot;Patients&quot;, Position:=msoBarTop, Temporary:=True)
cbr.Visible = True
cbr.Protection = msoBarNoMove

Set ctl = cbr.Controls.Add(Type:=msoControlDropdown, Before:=1)

With ctl
.Tag = &quot;PatientID&quot;
.Caption = &quot;Select Patient &Name:&quot;
.style = msoComboLabel
' Use the default width for the dropdown.
.DropDownWidth = 115
Set db = CurrentDb
'used the clone property here
Set rst = Forms!frmPT.RecordsetClone
Do While Not rst.EOF
.AddItem rst(&quot;PatName&quot
rst.MoveNext
Loop
.OnAction = &quot;FindRowInActiveControl3&quot;
rst.Sort = &quot;[PatName]&quot;
End With


Set ctl = cbr.Controls.Add(Type:=msoControlDropdown, Before:=2)

With ctl
.Tag = &quot;PatientSS&quot;
.Caption = &quot;Select Social Sec:&quot;
.style = msoComboLabel
' Use the default width for the dropdown.
.DropDownWidth = 75

'***now set the second combo box to a new recordset***

'***this would work but could not eliminate my blanks ***properly had to use sql statement and open new recordset
'Set rst = Forms!frmPT.RecordsetClone
'set rst2 = rst.clone

Set db = CurrentDb
Set rst = db.OpenRecordset(&quot;SELECT tblPT.*, * FROM tblPT WHERE ((Not (tblPT.txtSSN) Is Null)) ORDER BY tblPT.txtSSN;&quot
Set rst2 = rst

Do While Not rst.EOF
.AddItem rst2!txtSSN
rst2.MoveNext
Loop
' Although you could specify
' the OnAction property here,
' you can use WithEvents to
' trap the events of the combo box
' instead. This allows you more
' flexibility.
.OnAction = &quot;FindRowInActiveControl4&quot;
End With

Set ctl = cbr.Controls.Add(Type:=msoControlButton)

With ctl
.BeginGroup = True
.Caption = &quot;&Help&quot;
.style = msoButtonCaption
.OnAction = &quot;OpnPatHelp&quot;
End With

Set ctl = cbr.Controls.Add(Type:=msoControlButton)

With ctl
.BeginGroup = True
.Caption = &quot;&Exit&quot;
.style = msoButtonCaption
.OnAction = &quot;PatClose&quot;
End With
Set rst = Nothing
Set rst2 = Nothing
End Function