Remove item from listbox (1 Viewer)

GrayLowe

New member
Local time
Today, 05:56
Joined
Nov 27, 2019
Messages
8
I have a program that populates a list box with appointment times. It checks to see if the person is available and not already booked and populates the list with available times. I have now introduced an out of office system which allows the user to book time out, could be a couple of hours or a few days. The days one I have covered and it informs the appointment creator that the person is out of the office on that day. It is the time section. This is held in an unavailable file with date and time out from and to. This is where I have the problem. I need to remove these times from my value list. Any help would be great. This is my code.

Private Sub cboTime_Enter()
Dim i As Date, t As Date, n As Integer, oRS As DAO.Recordset, sSQL As String
Dim dLowerbreak As Date, dUpperBreak As Date, dDuration As Date
Dim dLowerPrecision As Date, dUpperPrecision As Date
Dim tSQL As String, tRS As DAO.Recordset
Dim tmpStart, tmpEnd, tmpBreak As Date
Dim n As Integer
Dim tmpcnt As Integer
Dim tmpListItem As Date


sSQL = "SELECT * FROM Unavailable WHERE #" & Me.txtAppointDate & "#>= DateFrom AND #" & Me.txtAppointDate & "#<= DateTo AND CounsellorID= " & Me.UserID & ""

Set oRS = CurrentDb.OpenRecordset(sSQL)

If oRS.RecordCount = 0 Then
Else
MsgBox "The Counsellor Selected is unavailable on the date selected, Please try another date"
Me.txtAppointDate.SetFocus
sSQL = ""
Set oRS = Nothing
Exit Sub
End If
'Set oRS = Nothing
'sSQL = ""

tmpStart = DLookup("[Start]", "tblUsers", "UserID =" & Nz([UserID], 0))
tmpEnd = DLookup("[End]", "tblUsers", "UserID =" & Nz([UserID], 0))
tmpBreak = DLookup("[Break]", "tblUsers", "UserID =" & Nz([UserID], 0))

cboTime.RowSourceType = "Value List"
cboTime.RowSource = ""
If IsNull(tmpStart) Then Exit Sub Else i = tmpStart
If Me.NewRecord = True Then
DoCmd.RunCommand acCmdSaveRecord
End If
sSQL = "SELECT appCounsellor, AppDate, StartTime"
sSQL = sSQL & " FROM qrySubformAppointments"
sSQL = sSQL & " WHERE appCounsellor= " & Me.UserID & _
" AND AppDate=#" & Me.txtAppointDate & "#"
Set oRS = CurrentDb.OpenRecordset(sSQL)

dDuration = TimeValue("01:00")
dLowerbreak = tmpBreak - TimeValue("00:25") 'Break is a field
dUpperBreak = tmpBreak + TimeValue("00:25")

tSQL = "SELECT TimeFrom, TimeTo FROM Unavailable WHERE #" & Me.txtAppointDate & "#= DateTime AND CounsellorID= " & Me.UserID & ""

Set tRS = CurrentDb.OpenRecordset(tSQL)


If oRS.RecordCount = 0 Then
Do
If i <= dLowerbreak Or i >= dUpperBreak Then
cboTime.AddItem i
End If
i = i + dDuration
Loop Until i >= tmpEnd
Else

Do
If i <= dLowerbreak Or i >= dUpperBreak Then
dLowerPrecision = i - TimeValue("00:00:05")
dUpperPrecision = i + TimeValue("00:00:05")
oRS.FindFirst "[StartTime] Between #" & dLowerPrecision & "# And #" & dUpperPrecision & "#"
If oRS.NoMatch Then cboTime.AddItem i
End If
i = i + dDuration
Loop Until i >= tmpEnd
End If
oRS.Close

How can I then scroll through my cboTime.RowSource and remove the times that fall between tRS!StartTime and TRS!EndTime. These are all in one hour intervals. Any help whatsoever would be greatly appreciated.
 

June7

AWF VIP
Local time
Today, 04:56
Joined
Mar 9, 2014
Messages
5,468
In future, please post lengthy code between CODE tags to retain indentation and readability. You can edit your post.

See if this helps https://docs.microsoft.com/en-us/office/vba/api/Access.ComboBox.RemoveItem

Loop through listbox items (from the end) and remove those that meet criteria. Something like (air code, not tested, remember seeing somewhere):
Code:
Dim i As Long, x As Integer
  With myCombo
    x = .ListCount
    For i = x To 0 Step -1
        If some criteria here Then .RemoveItem(i)
    Next
End With

Or completely rebuild the list again and only include items that meet criteria.
 
Last edited:

Pat Hartman

Super Moderator
Staff member
Local time
Today, 08:56
Joined
Feb 19, 2002
Messages
43,257
Modify your RowSource query to include the out of office table so those times can be eliminated. That way you can bind the query to the list and not have to write a code loop to fill it.
 

GrayLowe

New member
Local time
Today, 05:56
Joined
Nov 27, 2019
Messages
8
Thanks so much guys, the MS Doc pointed me in the right direction. I will remember the Code tags when posting again, this was my first post.
Thanks again.
 

Users who are viewing this thread

Top Bottom