Deleting multiple items from a listbox (1 Viewer)

[nashaz]

Hi all

In continuation of this thread, I am looking to have similar function where I can select multiple values and delete them at once, rather than deleting each value individually. My listbox is bound to a table, and as such row source type is set to table/query. Here is my code:

Dim i As Integer
Dim intCount As Integer
Dim aryValues() As Variant

For i = 0 To ListCourse.ListCount - 1
                If ListCourse.Selected(i) Then
                    ReDim Preserve aryValues(intCount)
                    aryValues(intCount) = i
                    intCount = intCount + 1
                End If
            Next i
            
            For i = UBound(aryValues) To 0 Step -1
                ListCourse.RemoveItem aryValues(i)
            Next i

The problem I am having with this solution, and others I have tried is with the line

ListCourse.RemoveItem aryValues(i). I get runtime error 6014: The RowSourceType property must be set to 'Value List' to use this method. I cannot have the rowsourcetype property as value list since the list will most likely see quite a few changes.

Any workaround suggestions will be appreciated, as always

 

[Gasman]

Think about it.
If your listbox is bound to a table, then you need to delete those records from that table or make them non retrievable with some sort of flag.

So select the ones you need to delete, then process that list. If selected, run a query to delete/mark that particular entry.
Then requery the listbox at the end.

 

[nashaz]

Think about it.
If your listbox is bound to a table, then you need to delete those records from that table or make them non retrievable with some sort of flag.

So select the ones you need to delete, then process that list. If selected, run a query to delete/mark that particular entry.
Then requery the listbox at the end.

Hi Gasman
Theoretically, it makes sense. But I am not sure how I would setup a query which will delete only the "selected" entries. Is there a way in query builder or VBA which can make the distinction between records which are selected and those which aren't?

 

[moke123]

You may have to alter the row source of the list box and add to the where clause to exclude the select values.

I've used this code in the past to parse the various sections of the SQL. I attached a DB where I used it.
Hope you can figure it out.

Public Function ReplaceWhereClause(strSql As Variant, strNewWHERE As Variant)    'replaces the where clause and returns modified Sql

    Dim strSelect As String, strWhere As String, strOrderBy As String

    Call ParseSQL(strSql, strSelect, strWhere, strOrderBy)

    ReplaceWhereClause = strSelect & " " & strNewWHERE & " " & strOrderBy

End Function

Public Function ParseKeyField(strSql As Variant) As String    'returns the name of the primary key field

    Dim lenStrSql As Integer
    Dim startFirstField As Integer, FirstComma As Integer, lenFirstField As Integer

    If InStr(1, strSql, "Select ") > 0 Then
        startFirstField = InStr(1, strSql, "Select ") + 6
        FirstComma = InStr(1, strSql, ",")
        lenFirstField = FirstComma - startFirstField
    End If

    ParseKeyField = Trim(Mid(strSql, startFirstField, lenFirstField))

End Function

Public Sub ParseSQL(strSql As Variant, strSelect As Variant, strWhere As Variant, strOrderBy As Variant)    'parses the Sql string into "select","Where", and "orderBy" parts

    Dim intStartSELECT As Integer, intStartWHERE As Integer, intStartORDERBY As Integer
    Dim intLenSQL As Integer, intLenSELECT As Integer, intLenWHERE As Integer, intLenORDERBY As Integer

    intStartSELECT = InStr(strSql, "SELECT ")
    intStartWHERE = InStr(strSql, "WHERE ")
    intStartORDERBY = InStr(strSql, "ORDER BY ")

    If InStr(strSql, ";") Then

        strSql = Left(strSql, InStr(strSql, ";") - 1)

    End If

    intLenSQL = Len(strSql)

    If intStartSELECT > 0 Then

        intLenSELECT = intLenSQL - intStartSELECT + 1

        If intStartWHERE > 0 And intStartWHERE > intStartSELECT And intStartWHERE < intStartSELECT + intLenSELECT Then

            intLenSELECT = intStartWHERE - intStartSELECT

        End If

        If intStartORDERBY > 0 And intStartORDERBY > intStartSELECT And intStartORDERBY < intStartSELECT + intLenSELECT Then

            intLenSELECT = intStartORDERBY - intStartSELECT

        End If

    End If

    If intStartORDERBY > 0 Then

        intLenORDERBY = intLenSQL - intStartORDERBY + 1

        If intStartWHERE > 0 And intStartWHERE > intStartORDERBY And intStartWHERE < intStartORDERBY + intLenORDERBY Then

            intLenORDERBY = intStartWHERE - intStartORDERBY

        End If

        If intStartWHERE > 0 Then

            intLenWHERE = intLenSQL - intStartWHERE + 1

            If intStartORDERBY > 0 And intStartORDERBY > intStartWHERE And intStartORDERBY < intStartWHERE + intLenWHERE Then

                intLenWHERE = intStartORDERBY - intStartWHERE
            End If

        End If

    End If

    If intStartSELECT > 0 Then

        strSelect = Mid$(strSql, intStartSELECT, intLenSELECT)

    End If

    If intStartORDERBY > 0 Then

        strOrderBy = Mid$(strSql, intStartORDERBY, intLenORDERBY)

    End If

    If intStartWHERE > 0 Then

        strWhere = Mid$(strSql, intStartWHERE, intLenWHERE)

    End If

End Sub

Public Function CleanSql(strSql As String) As String

    CleanSql = Trim(Replace(strSql, ";", ""))    ' remove trailing ;

End Function

 

[moke123]

Hi Gasman
Theoretically, it makes sense. But I am not sure how I would setup a query which will delete only the "selected" entries. Is there a way in query builder or VBA which can make the distinction between records which are selected and those which aren't?

If your using a multi-select listbox you can use something like the below code. It will return a string of the selected items in your multi-select listbox

Public Enum eDelimiterType
    NoDelimiter = 0
    DoubleQuotes = 1
    Octothorpes = 2
    SingleQuotes = 3
End Enum


Public Enum eSeperatorType
    Comma = 0
    Pipe = 1
    SemiColon = 2
    Tilde = 3
    NewLine = 4
End Enum


' ----------------------------------------------------------------
' Procedure Name: fGetLbx
' Purpose: Get array of item in a multiselect listbox
' Procedure Kind: Function
' Procedure Access: Public
' Parameter lbx (ListBox): Your listbox object (ie. Me.MyList)
' Parameter intColumn (Integer): The listbox column to return
' Parameter Seperator (eSeperatorType): character seperating the array values
' Parameter Delimiter (eDelimiterType): Delimiters for array values (ie.Double Quotes or Octothorpes)
' Return Type: Variant
' Author: Moke123
'
' **** NOTE **** Returns Null if no items selected. Use NZ() in calling code to handle nulls
'
' ----------------------------------------------------------------


Public Function fGetLbx(lbx As ListBox, Optional intColumn As Integer = 0, Optional Seperator As eSeperatorType = 0, _
    Optional Delimiter As eDelimiterType = 0) As Variant

    On Error GoTo fGetLbx_Error
    
    Dim strlist As String, varSelected As Variant, DeLimit As Variant, SepChar As String
    
    Select Case Delimiter
        Case 0
            DeLimit = Null
        Case 1
            DeLimit = Chr(34) 'Quotes
        Case 2
            DeLimit = Chr(35) 'Octothorpes
        Case 3
            DeLimit = Chr(39) 'SingleQuotes
    End Select
                
    Select Case Seperator
        Case 0
            SepChar = Chr(44)   'comma
        Case 1
            SepChar = Chr(124)  'pipe
        Case 2
            SepChar = Chr(59)   'semicolon
        Case 3
            SepChar = Chr(126)  'tilde
        Case 4
            SepChar = vbNewLine 'newline
                
    End Select
 
    If lbx.ItemsSelected.Count > 0 Then
  
        For Each varSelected In lbx.ItemsSelected

            If lbx.Column(intColumn, (varSelected)) <> "" Then
            
                If strlist <> "" Then
                    strlist = strlist & SepChar & DeLimit & lbx.Column(intColumn, (varSelected)) & DeLimit
                Else
                    strlist = DeLimit & lbx.Column(intColumn, (varSelected)) & DeLimit
                End If

            End If

        Next varSelected
        
        fGetLbx = strlist
        
    Else
    
        fGetLbx = Null
        
    End If
    
    On Error GoTo 0
    Exit Function

fGetLbx_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure fGetLbx, line " & Erl & "."

End Function

 

[MajP]

It is unclear if you just want to remove from the list or if you want to do something to those removed items. I do this a little easier. I simply convert to a value list. I just pass in the listbox and it takes the rowsource and then creates a value list. Probably does not work with parameterized queries.

Public Sub convertToValueList(lstBox As Access.ListBox)
    Dim rs              As dao.Recordset
    Dim strSql          As String
    Dim fldField        As dao.Field
    Dim fldCount        As Integer
    Dim strLstValue     As String
    Dim intColCount     As Integer
    Dim intRowCounter   As Integer
    Dim i               As Integer
   
    strSql = lstBox.RowSource
    lstBox.RowSource = ""
    Set rs = CurrentDb.OpenRecordset(strSql)
    lstBox.RowSourceType = "Value List"
   
    'IF LBOX COLUMN COUNT PROPERTY > ROWSOURCE COLUMNS - ERROR
    fldCount = rs.Fields.Count
    If lstBox.ColumnCount > fldCount Then
        lstBox.ColumnCount = fldCount
    End If
   
    intColCount = lstBox.ColumnCount
    'Since converting to value list column heads do not work
    If lstBox.ColumnHeads Then
       MsgBox "Unfortunately, this will not work with column heads. You will have to make your own.", vbInformation
       lstBox.ColumnHeads = False
    End If
   
    Do While Not rs.EOF
       For i = 0 To intColCount - 1
          strLstValue = strLstValue & """" & CStr(Nz(rs.Fields(i), " ")) & """;"
       Next i
     
       intRowCounter = intRowCounter + 1
       rs.MoveNext
       strLstValue = Left(strLstValue, Len(strLstValue) - 1)
       lstBox.addItem (strLstValue)
       strLstValue = ""
    Loop
End Sub

To use the procedure

Private Sub Form_Load()
  convertToValueList Me.lstOne
End Sub

Now you can add and edit the list or move the items around. This idea is used in my listobx sorter

MS Access: custom control built in another language

the code is old and there is a small change you need to make in several functions, e.g. fIsScrollBar, there is a line which is used to identify the scrollbar for a window If fGetClassName(hWnd_VSB) = "scrollBar" Then this needs to be changed to If fGetClassName(hWnd_VSB) = "NUIscrollBar"...

www.access-programmers.co.uk