Question : How to create Access Check Box Pick List Form

I have an Access 2000 Report which displays data from MS SQL Tables based on a DATE Parameter entered into a form which appears when the end user runs the report from within Access.

What I need to do is to expand on this existing [or start from scratch] process and add an additional step where the end user will be able to select which data is displayed on the form, rather than all data based on the date.

The logic would be:

1. Run the report
2. Prompt user for Date Parameter [single date not range]
3. Prompt user with a form which displays all 'routes' for that date. Each route will have a check box next to it. Once the end user selects all the desired routes using the check boxes, they will click a button which will:
4. Display the report as defined by the parameters above

I have the report design [as it was given to me].
I have the query which displays ALL the 'routes' data in the report.
I know which server, db, and tables will be used.

I am not sure how to tie it all together, especially the check box form [which has yet to be created].
Code Snippet: 
1:
2:
3:
4:
5:

SELECT ROUTE_SETS.ROUTING_DATE, ROUTES.ROUTE_NAME, DRIVER.NAME, DRIVER_1.NAME AS DRIVER2NAME, DRIVER_1.EMPLOYEENUMBER AS EMPLOYEENUMBER2, VEHICLE.NAME, VEHICLE.ODOMETER, CUSTOMER.WHOLE_ACCOUNT_ID, ORDERS.ORDER_ID, CUSTOMER.NAME, CUSTOMER.STREET_ADDRESS, CUSTOMER.PHONE_NUMBER, ORDERS.HW_OPEN_TIME, ORDERS.HW_CLOSE_TIME, ROUTE_STOPS.ARRIVAL_TIME, ROUTE_STOPS.DEPARTURE_TIME, CUSTOMER.STOP_ID, VEHICLE_1.NAME, VEHICLE.DRIVER_ID1, VEHICLE.VEHICLETYPE, VEHICLE_1.VEHICLETYPE, DRIVER.EMPLOYEENUMBER, ROUTE_STOPS.STOP_NUMBER, ORDERS.COMMENT_ROUTE_SHEET, ORDERS.ORDER_SIZE_VOLUME, ROUTES.DISPATCH_TIME, ROUTES.DELIVERY_VOLUME, VEHICLE_1.DRIVER_ID2, DRIVER.TEAMMATEID, ROUTES.DRIVER_ID2, ROUTES.VEHICLE_TYPE3, VEHICLE_2.NAME, CUSTOMER.NICKNAME, STOP.STOP_NAME, STOP.STREET_ADDRESS, STOP.CITY, STOP.STATE, STOP.COMMENTS, STOP.PHONE_NUMBER, STOP.ZIP
FROM (((((ROUTE_STOPS INNER JOIN (((VEHICLE INNER JOIN (ROUTE_SETS INNER JOIN ROUTES ON ROUTE_SETS.ROUTE_SET_INDEX = ROUTES.ROUTE_SET_INDEX) ON VEHICLE.VEHICLE_ID = ROUTES.VEHICLE_ID1) LEFT JOIN VEHICLE AS VEHICLE_1 ON ROUTES.VEHICLE_ID2 = VEHICLE_1.VEHICLE_ID) INNER JOIN DRIVER ON ROUTES.DRIVER_ID1 = DRIVER.INTERNALID) ON ROUTE_STOPS.ROUTE_INDEX = ROUTES.ROUTE_INDEX) INNER JOIN RSTOP_ORDER ON ROUTE_STOPS.STOP_INDEX = RSTOP_ORDER.STOP_INDEX) INNER JOIN (CUSTOMER INNER JOIN ORDERS ON CUSTOMER.CUSTOMER_ID = ORDERS.CUSTOMER_ID) ON RSTOP_ORDER.ORDER_ID = ORDERS.ORDER_ID) LEFT JOIN DRIVER AS DRIVER_1 ON ROUTES.DRIVER_ID2 = DRIVER_1.INTERNALID) LEFT JOIN VEHICLE AS VEHICLE_2 ON ROUTES.VEHICLE_ID3 = VEHICLE_2.VEHICLE_ID) INNER JOIN STOP ON ROUTE_STOPS.STOP_ID = STOP.STOP_ID
GROUP BY ROUTE_SETS.ROUTING_DATE, ROUTES.ROUTE_NAME, DRIVER.NAME, DRIVER_1.NAME, DRIVER_1.EMPLOYEENUMBER, VEHICLE.NAME, VEHICLE.ODOMETER, CUSTOMER.WHOLE_ACCOUNT_ID, ORDERS.ORDER_ID, CUSTOMER.NAME, CUSTOMER.STREET_ADDRESS, CUSTOMER.PHONE_NUMBER, ORDERS.HW_OPEN_TIME, ORDERS.HW_CLOSE_TIME, ROUTE_STOPS.ARRIVAL_TIME, ROUTE_STOPS.DEPARTURE_TIME, CUSTOMER.STOP_ID, VEHICLE_1.NAME, VEHICLE.DRIVER_ID1, VEHICLE.VEHICLETYPE, VEHICLE_1.VEHICLETYPE, DRIVER.EMPLOYEENUMBER, ROUTE_STOPS.STOP_NUMBER, ORDERS.COMMENT_ROUTE_SHEET, ORDERS.ORDER_SIZE_VOLUME, ROUTES.DISPATCH_TIME, ROUTES.DELIVERY_VOLUME, VEHICLE_1.DRIVER_ID2, DRIVER.TEAMMATEID, ROUTES.DRIVER_ID2, ROUTES.VEHICLE_TYPE3, VEHICLE_2.NAME, CUSTOMER.NICKNAME, STOP.STOP_NAME, STOP.STREET_ADDRESS, STOP.CITY, STOP.STATE, STOP.COMMENTS, STOP.PHONE_NUMBER, STOP.ZIP
HAVING (((ROUTE_SETS.ROUTING_DATE)=[Enter Routing Date]) AND ((ROUTES.ROUTE_NAME)=[ENTER ROUTE_NAME]))
ORDER BY ROUTES.ROUTE_NAME;
Open in New Window
Select All

Answer : How to create Access Check Box Pick List Form

open the code for the add item button and select all this will include the other buttons and replace with the following. this should work with access 2000. but i donot have it so we may have to do a remote session to get the buggs worked out. in such a case i will create us each temporay email addresses so we can better share information. 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:

Option Compare Database

Private Sub Command10_Click()

Dim strItems As String
Dim intCurrentRow As Integer
For intCurrentRow = 0 To List6.ListCount - 1
    If List6.Selected(intCurrentRow) Then
        Listbox_RemoveItem List6, (intCurrentRow)
        'List6.RemoveItem (intCurrentRow)
        Exit Sub
    End If
Next intCurrentRow
End Sub

Private Sub Command11_Click()
Listbox_Clear List6

'removed the following
'Dim strItems As String
'Dim intCurrentRow As Integer
'For intCurrentRow = List6.ListCount - 1 To 0 Step -1
'        List6.RemoveItem (intCurrentRow)
'Next intCurrentRow
End Sub

Private Sub Command4_Click()
    DoCmd.Close
End Sub

Private Sub Command5_Click()
Dim myfilter As String
Dim inlist As String

'This is the section that may have to be edited
  If IsNull(Text0) Or List6.ListCount < 1 Then
    MsgBox "Missing date or route selection."
    Exit Sub
  End If
  Dim strItems As String
Dim intCurrentRow As Integer
For intCurrentRow = 0 To List6.ListCount - 1
inlist = inlist & "[ROUTES.ROUTE_NAME]=#'" & List6.ItemData(intCurrentRow) & "' OR "
Next intCurrentRow
inlist = Mid(inlist, 1, Len(inlist) - 3) ' section not needed ??? --->& "[ROUTE_SETS.ROUTING_DATE]=#" & Text0 & "#"
 'remove the next line once the code is working
MsgBox inlist
 ' old myfilter = "[ROUTE_SETS.ROUTING_DATE]=#" & Text0 & "# AND [ROUTES.ROUTE_NAME]='" & List2 & "'"
 ' this line opens the filtered report
     DoCmd.OpenReport "Delivery Instructions", acViewReport, "", myfilter, acNormal

End Sub

Private Sub Command8_Click()
Dim strItems As String
Dim intCurrentRow As Integer
For intCurrentRow = 0 To List2.ListCount - 1
    If List2.Selected(intCurrentRow) Then
        Listbox_AddItem List6, List2.Column(0, intCurrentRow), False
       ' replaced this line with the one above
       ' List6.AddItem List2.Column(0, intCurrentRow), List6.ListCount
    End If
Next intCurrentRow
End Sub

Private Sub List2_DblClick(Cancel As Integer)
Command8_Click
End Sub

Private Sub Text0_LostFocus()
'Changes the list2 data to reflect the date in text0
List2.Requery
End Sub
'************************************Added Section

'This is equivalent to ListBox1.Clear
Sub Listbox_Clear(lbx As ListBox)
    lbx.RowSource = ""
    lbx.RowSourceType = "Value List"
End Sub
Sub Listbox_AddItem(lbx As ListBox, NewValue As String, Optional Sorted = False)
    Dim xList() As String
    Dim Count As Integer
    Dim I As Integer
    Dim J As Integer
    Dim IdxPtr As Integer
    Count = lbx.ListCount
    ReDim xList(Count + 1) As String
    For I = 1 To Count
      xList(I) = lbx.ItemData(I - 1)
    Next
    xList(Count + 1) = NewValue
    If Sorted Then
      For I = 1 To Count
        For J = I + 1 To Count + 1
          If xList(I) > xList(J) Then
            SwapStr xList(I), xList(J)
          End If
        Next
      Next
    End If
    On Local Error Resume Next
    lbx.RowSource = ListedItems(xList())
 End Sub
Sub Listbox_RemoveItem(lbx As ListBox, Index As Integer)
    Dim xList() As String
    Dim Count As Integer
    Dim I As Integer
    Dim IDX As Integer
    On Local Error GoTo ERR_Listbox_RemoveItem
    Count = lbx.ListCount
    ReDim xList(Count - 1) As String
    IDX = 0
    For I = 1 To Count
      If (I - 1) <> Index Then
        IDX = IDX + 1: xList(IDX) = lbx.ItemData(I - 1)
      End If
    Next
    lbx.RowSource = ListedItems(xList())
    If Index + 1 > lbx.ListCount Then
      lbx.ListIndex = Index - 1
    Else
      lbx.ListIndex = Index
    End If
ERR_Listbox_RemoveItem:
End Sub
Private Function ListedItems(Lists() As String)
    Dim HiEnd As Integer
    Dim NewList As String
    Dim I As Integer
    HiEnd = UBound(Lists)
    NewList = ""
    For I = 1 To HiEnd
      NewList = NewList & Lists(I) & ";"
    Next
    ListedItems = NewList
End Function
Private Sub SwapStr(Tx1 As String, Tx2 As String)
    Dim Tx3 As String
    Tx3 = Tx1
    Tx1 = Tx2
    Tx2 = Tx3
End Sub
Open in New Window
Select All
Random Solutions  
 
programming4us programming4us