Filtering a list box based on two criteria

[Rowland1986]

I have attempted to search for the answer to my issue but even though there seems to many posts similar, I have been unable to adapt any of the solutions provided to achieve my desired outcome.

From the answers I have read it appears to be quite simple but being new to VBA I have been struggling all week so would like to ask for some assistance if possible.

I currently have an Excel database located in the following folder, H:\Personal\Main Spreadsheets\Test.xlsx. I am running a user form that is separate from the database which my staff use to data enter and transfer to the database.

On occasion the information is not completed on the day of entry and needs to be revisited at a later date and these are left with a status "ongoing".

One page of my form has a combo box "combobox1", a listbox "list_data" and a command button "CommandButton1".

The aim is for a staff member to be able to choose their name from the combo box and then click the command button which will then return any rows where both the status is "ongoing" and the entry in the staff member column matches the combo box entry.

At present there are 57 columns (starting "A" and ending "BE") on the database with the staff member column being located in column "P" and the status column being "AE".

Unfortunately I do not have any code to offer up as start as everything I have tried has been unsuccessful so have deleted after each attempt.

Any assistance with this query would be greatly appreciated. If your require any further information that I have forgotten to mention please let me know.

Kind Regards

 

[dmt32]

Hi,
As a suggestion, build an array of rows that match your criteria & use this to populate your controls
is it your intention to return all 57 columns of matching rows to your listbox?

Dave

 

[Rowland1986]

Hi dmt32,

Unfortunately I am unsure what you mean by build an array of rows and yes I would need all 57 columns as it will be required that double clicking on a line in the list box imports the data back to the form for all fields and then re save over the same row in the database once information has been updated.

 

[dmt32]

Hi dmt32,

Unfortunately I am unsure what you mean by build an array of rows and yes I would need all 57 columns as it will be required that double clicking on a line in the list box imports the data back to the form for all fields and then re save over the same row in the database once information has been updated.

just that, build an array of rows that match your criteria to populate the listbox.

not been able to test but see if following works for you

Place following in your userforms code page

Private Sub CommandButton1_Click()
    Dim FileName As String, FolderPath As String
    Dim wbOpenPassword As String, Search As String
    Dim RecordData As Variant
    
'*****************************************************************************
'*********************************SETTINGS************************************
    wbOpenPassword = ""
    FolderPath = "H:\Personal\Main Spreadsheets\"
    FileName = "Test.xlsx"
    
'*****************************************************************************


   
    Search = Me.ComboBox1.Text
    If Len(Search) = 0 Then Exit Sub
    
'GetOngoingRecords Function returns a 2D variant array
        RecordData = GetOngoingRecords(FolderPath & FileName, Search, wbOpenPassword)
        
        If Not IsError(RecordData) Then
'load listbox
            With Me.list_data
                .ColumnCount = UBound(RecordData, 2)
                .List = RecordData
            End With


        End If


End Sub

you will need to define the column widths of your listbox


Place Following in a STANDARD module

Function GetOngoingRecords(ByVal FileName As String, ByVal Search As String, Optional ByVal wbPassword As String) As Variant
    Dim FoundCell As Range
    Dim FirstAddress As String
    Dim wbDataBase As Workbook
    Dim DatabaseRecords As Variant, OngoingRecords As Variant
    Dim MatchCount As Long, r As Long, c As Long, i As Long
    
     On Error GoTo exitfunction
'check file / folder exists
    If Not Dir(FolderPath & FileName, vbNormal) = vbNullString Then
        Application.ScreenUpdating = False
'open database read only
        Set wbDataBase = Workbooks.Open(FileName, ReadOnly:=True, Password:=wbPassword)
'database is sheet 1
        With wbDataBase.Worksheets(1)
'worksheet MUST NOT BE PROTECTED - add password if required
            .Unprotect Password:=""
'intilaize DatabaseRecords array
            DatabaseRecords = .Range("A1").CurrentRegion
'count matching records
            MatchCount = Application.CountIfs(.Columns(16), Search, .Columns(31), "ONGOING")
        End With
        
        If MatchCount > 0 Then
'size OngoingRecords array
            ReDim OngoingRecords(1 To MatchCount, 1 To UBound(DatabaseRecords, 2))
            
            For r = 1 To UBound(DatabaseRecords, 1)
                If DatabaseRecords(r, 16) = Search And UCase(DatabaseRecords(r, 31)) = "ONGOING" Then
                    i = i + 1
                    For c = 1 To UBound(DatabaseRecords, 2)
'build OngoingRecords array
                        OngoingRecords(i, c) = DatabaseRecords(r, c)
                    Next c
                End If
            Next r
'return array
        GetOngoingRecords = OngoingRecords
        Else
'inform user
          MsgBox Search & Chr(10) & "No Ongoing Record(s) Found", 48, "Not Found"
        End If
                       
        Else
         MsgBox FileName & Chr(10) & Space(Len(FileName) / 2) & "File / Folder Not Found", 48, "Not Found"
    End If
            
exitfunction:
'close database without saving
    If Not wbDataBase Is Nothing Then wbDataBase.Close False
'raise error if GetOngoingRecords Empty
    If IsEmpty(GetOngoingRecords) Then GetOngoingRecords = CVErr(10)
    Application.ScreenUpdating = True
'inform user
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Function

Hopefully, what I have done is clear enough & will do what you want. You will need to adjust code to meet specific protect need as required


Hope helpful

Dave

 

[Rowland1986]

Hi Dave

Having looked through the code and applied it to the form I think I'm starting to understand how it works and with a little tweaking for correct worksheets it is now working perfectly.

Thank you very much.

 

[dmt32]

Hi Dave

Having looked through the code and applied it to the form I think I'm starting to understand how it works and with a little tweaking for correct worksheets it is now working perfectly.

Thank you very much.

Hi,
glad solution helped you - if not familiar with arrays then worth taking time to read up - in many cases, can make your code much faster.

Dave.