Application-defined or object defined Error when Filtering Listbox

A

aabrazil1

New Member
Joined
Feb 11, 2024
Messages
19
Office Version
  1. 2021
Platform
  1. Windows
Hello All,

The error is 32nd line from the bottom marked 'Error Message here. It kicks in when I use the filter I added to the listbox. Do you know what causes this?


1707851822476.png


1707851901535.png



VBA Code: 
Sub Reset3()
    Dim iRow As Long
        iRow = [Counta(DatabaseTDMS!A:A)]
        With frmform3
            .cmbTdms.Clear
            .cmbTdms.AddItem "Pre-TDMS Drawing"
            .cmbTdms.AddItem "Drawing"
            .cmbTdms.AddItem "Engineering Order"
            .cmbTdms.AddItem "Work Order Authorization"
            .cmbTdms.AddItem "Work Order Authorization Pending"
            .cmbTdms.AddItem "Work Order Authorization Deviation"
            .cmbTdms.AddItem "Work Order Authorization Continuation Sheet"
            .cmbTdms.AddItem "Work Order Authorization Event Unscheduled"
            .cmbTdms.AddItem "Data Packs"
            .cmbTdms.AddItem "Score"
            .cmbTdms.AddItem "Data Packs"
            .cmbTdms.AddItem "Specification"
            .cmbTdms.AddItem "Problem Report from TDMS"
            .cmbTdms.AddItem "Problem Report from Building 5"      
            .txtNumber.Value = " "
            .txtrev.Value = " "
            .txtsubrev = " "        
            .cmbsystem.Clear      
              .cmbsystem.AddItem "ACS"
        .cmbsystem.AddItem "Archive Data"
         .cmbsystem.AddItem "ATDS"
        .cmbsystem.AddItem "Autocapture Testbed"
         .cmbsystem.AddItem "AVN"
        .cmbsystem.AddItem "C&DH"
         .cmbsystem.AddItem "CBS"
        .cmbsystem.AddItem "COMLIDAR"
         .cmbsystem.AddItem "COMM"
        .cmbsystem.AddItem "COMSEC"
         .cmbsystem.AddItem "EGSE"
        .cmbsystem.AddItem "EGSE (Flight I&T)"
         .cmbsystem.AddItem "EPS"
        .cmbsystem.AddItem "FlatSat"
         .cmbsystem.AddItem "FSW"
        .cmbsystem.AddItem "HFCS"
         .cmbsystem.AddItem "L7 Mockups (Flight I&T)"
        .cmbsystem.AddItem "Landsat 7"
         .cmbsystem.AddItem "LIDAR"
        .cmbsystem.AddItem "MECH"
         .cmbsystem.AddItem "MGSE (Flight I&T)"
        .cmbsystem.AddItem "PCC"
         .cmbsystem.AddItem "PROP"
        .cmbsystem.AddItem "PSU"
         .cmbsystem.AddItem "PTS"
        .cmbsystem.AddItem "RDT"
         .cmbsystem.AddItem "REU"
        .cmbsystem.AddItem "ROBOT"
         .cmbsystem.AddItem "RPO"
        .cmbsystem.AddItem "RPO Testbed"
         .cmbsystem.AddItem "SC"
        .cmbsystem.AddItem "SCTHRM"
         .cmbsystem.AddItem "Servicing Payload (PYLD)"
        .cmbsystem.AddItem "Serviving Testbed"
         .cmbsystem.AddItem "Simulators"
        .cmbsystem.AddItem "SP/SV/SC SPIDER GSE"
        .cmbsystem.AddItem "Spave Vehicle Management"
        .cmbsystem.AddItem "SPIDER"
         .cmbsystem.AddItem "SPINT"
        .cmbsystem.AddItem "STR"
         .cmbsystem.AddItem "SVINT"
        .cmbsystem.AddItem "Testbeds"
         .cmbsystem.AddItem "THRM"
        .cmbsystem.AddItem "TOOL"
        .cmbsystem.AddItem "VDSU"
        .cmbsystem.AddItem "VSS"        
        .optAccept.Value = False
        .optReject.Value = False      
        .txtAuthor.Value = " "
        .txtnotes.Value = " "       
        .cmbDefect1a.Clear        
        .cmbDefect1a.AddItem "10 - Missing appropriate QA"
        .cmbDefect1a.AddItem "20 - Missing Dimensions"
        .cmbDefect1a.AddItem "30 - Incorrect drawing call outs"
        .cmbDefect1a.AddItem "40 - Missing photos"
        .cmbDefect1a.AddItem "50 - Missing reference information"
        .cmbDefect1a.AddItem "60 - Incorrect reference materials"
        .cmbDefect1a.AddItem "70 - Incorrect event code"
        .cmbDefect1a.AddItem "80 - Accept"    
        .cmbDefect1b.Clear
        .cmbDefect1b.AddItem "10 - Missing appropriate QA"
        .cmbDefect1b.AddItem "20 - Missing Dimensions"
        .cmbDefect1b.AddItem "30 - Incorrect drawing call outs"
        .cmbDefect1b.AddItem "40 - Missing photos"
        .cmbDefect1b.AddItem "50 - Missing reference information"
        .cmbDefect1b.AddItem "60 - Incorrect reference materials"
        .cmbDefect1b.AddItem "70 - Incorrect event code"
        .cmbDefect1b.AddItem "80 - Accept"     
         .cmbDefect1c.Clear      
        .cmbDefect1c.AddItem "10 - Missing appropriate QA"
        .cmbDefect1c.AddItem "20 - Missing Dimensions"
        .cmbDefect1c.AddItem "30 - Incorrect drawing call outs"
        .cmbDefect1c.AddItem "40 - Missing photos"
        .cmbDefect1c.AddItem "50 - Missing reference information"
        .cmbDefect1c.AddItem "60 - Incorrect reference materials"
        .cmbDefect1c.AddItem "70 - Incorrect event code"
        .cmbDefect1c.AddItem "80 - Accept"       
           .cmbdefect1d.Clear        
        .cmbdefect1d.AddItem "10 - Missing appropriate QA"
        .cmbdefect1d.AddItem "20 - Missing Dimensions"
        .cmbdefect1d.AddItem "30 - Incorrect drawing call outs"
        .cmbdefect1d.AddItem "40 - Missing photos"
        .cmbdefect1d.AddItem "50 - Missing reference information"
        .cmbdefect1d.AddItem "60 - Incorrect reference materials"
        .cmbdefect1d.AddItem "70 - Incorrect event code"
        .cmbdefect1d.AddItem "80 - Accept"   
         .cmbdefect2a.Clear       
         .cmbdefect2a.AddItem "10 - Missing appropriate QA"
         .cmbdefect2a.AddItem "20 - Missing dimensions"
         .cmbdefect2a.AddItem "30 - Incorrect drawing call outs"
         .cmbdefect2a.AddItem "40 - Missing photos"
         .cmbdefect2a.AddItem "50 - Missing reference information"
         .cmbdefect2a.AddItem "60 - Incorrect reference materials"
         .cmbdefect2a.AddItem "70 - Incorrect event code"
         .cmbdefect2a.AddItem "80 - Deviation required"
         .cmbdefect2a.AddItem "90 - PR required"
         .cmbdefect2a.AddItem "100 - Accept"      
         .txtRowNumber.Value = " "         
         'Below code are associated with Search Feature - Part 3         
         Call Add_SearchColumn3
         ThisWorkbook.Sheets("DatabaseTDMS").AutoFilterMode = False
         ThisWorkbook.Sheets("SearchDataTDMS").AutoFilterMode = False
         ThisWorkbook.Sheets("SearchDataTDMS").Cells.Clear         
         '----------------------------------------------------------
        .lstdatabase.ColumnCount = 16
        .lstdatabase.ColumnHeads = True        
        .lstdatabase.ColumnWidths = "20,50,40,20,20,40,10,40,40,40,40,40,40,30,40,40"        
        If iRow > 1 Then     
            .lstdatabase.RowSource = "DatabaseTDMS!A2:P" & iRow            
        Else
            .lstdatabase.RowSource = "DatabaseTDMS!A2:P2"
        End If        
    End With   
End Sub

Sub Submit3()
    Dim Sh As Worksheet
    Dim iRow As Long    
    Set Sh = ThisWorkbook.Sheets("DatabaseTDMS")    
    If frmform3.txtRowNumber.Value = " " Then      
    iRow = [Counta(DatabaseTDMS!A:A)] + 1       
    Else     
      iRow = frmform3.txtRowNumber.Value
    End If          
    With Sh   
        .Cells(iRow, 1) = iRow - 1     
        .Cells(iRow, 2) = frmform3.cmbTdms.Value        
        .Cells(iRow, 3) = frmform3.txtNumber.Value        
        .Cells(iRow, 4) = frmform3.txtrev.Value       
        .Cells(iRow, 5) = frmform3.txtsubrev.Value        
        .Cells(iRow, 6) = frmform3.cmbsystem.Value        
        .Cells(iRow, 7) = IIf(frmform3.optAccept.Value = True, "A", "R")       
        .Cells(iRow, 8) = frmform3.txtAuthor.Value      
        .Cells(iRow, 9) = frmform3.txtnotes.Value      
        .Cells(iRow, 10) = frmform3.cmbDefect1a.Value       
        .Cells(iRow, 11) = frmform3.cmbDefect1b.Value        
        .Cells(iRow, 12) = frmform3.cmbDefect1c.Value    
        .Cells(iRow, 13) = frmform3.cmbdefect1d.Value        
        .Cells(iRow, 14) = frmform3.cmbdefect2a.Value        
        .Cells(iRow, 15) = Application.userName
        .Cells(iRow, 16) = [Text(Now(), "MM-DD-YYYY HH:MM:SS")]
    End With      
 End Sub
 
Sub Show_Form3()
    frmform3.Show
    End Sub
    
Function Selected_List3() As Long
    Dim i As Long
    Selected_List3 = 0
    For i = 0 To frmform3.lstdatabase.ListCount - 1
       If frmform3.lstdatabase.Selected(i) = True Then
       Selected_List3 = i + 1
       Exit For
      End If
    Next i
End Function

Sub Add_SearchColumn3()
    frmform3.EnableEvents = False
    With frmform3.cmbSearchColumn
        .Clear
        .AddItem "All"
        .AddItem "Type"
        .AddItem "Doc Num"
        .AddItem "Rev"
        .AddItem "Sub Rev"
        .AddItem "System"
        .AddItem "AcceptReject"
        .AddItem "Author"
        .AddItem "Notes"
        .AddItem "Defect Code 1a"
        .AddItem "DC 1b"
        .AddItem "DC 1c"
        .AddItem "DC 1d"
        .AddItem "DC 2a"
        .AddItem "QE"
        .AddItem "Date"        
        .Value = "All"
    End With           
       frmform3.EnableEvents = True    
       frmform3.txtSearch.Value = " "
       frmform3.txtSearch.Enabled = False
       frmform3.cmdSearch.Enabled = False           
End Sub
Sub SearchData3()
    Application.ScreenUpdating = False    
    Dim shDatabase As Worksheet 'Database Sheet    
    Dim shSearchData As Worksheet 'SearchData Sheet
    Dim iColumn As Integer 'To hold the selected column number in Database sheet
    Dim iDatabaseRow As Long 'To store the last non-blank row number avaliable in SearchData sheet
    Dim iSearchRow As Long 'To hold the last non-blank row number available in SearchDate Sheet    
    Dim sColumn As String 'To store the column selection
    Dim sValue As String 'To hold the search text value    
    Set shDatabase = ThisWorkbook.Sheets("DatabaseTDMS")
    Set shSearchData = ThisWorkbook.Sheets("SearchDataTDMS")   
    iDatabaseRow = ThisWorkbook.Sheets("DatabaseTDMS").Range("A" & Application.Rows.Count).End(x1Up).Row   'ERROR MESSAGE HERE**********'
    sColumn = frmform3.cmbSearchColumn.Value
    sValue = frmform3.txtSearch.Value
    iColumn = Application.WorksheetFunction.Match(sColumn, shDatabase.Range("A1:P1"), 0)    
    'Remove filter from DatabaseTDMS worksheet
       If shDatabase.AutoFilterMode = True Then
       shDatabase.AutoFilterMode = False
    End If
    'Apply filter on databaseTDMS worksheet
    If frmform3.cmbSearchColumn.Value = "Type" Then   
        shDatabase.Range("A1:P" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:=sValue
    Else
        shDatabase.Range("A1:P" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:="*" & sValue & "*"
    End If
       If Application.WorksheetFunction.Subtotal(3, shDatabase.Range("C:C")) >= 2 Then
       'Code to remove the previous data from SeachData worksheet
        shSearchData.Cells.Clear  
        shDatabase.AutoFilter.Range.Copy shSearchData.Range("A1")
        Application.CutCopyMode = False
        iSearchRow = shSearchData.Range("A" & Application.Rows.Count).End(x1Up).Row
        frmform3.lstdatabase.ColumnCount = 16
        frmform3.lstdatabase.ColumnWidths = "40,40,40,40,40,40,40,40,40,40,40,40,40,40,40,40"
        If iSearchRow > 1 Then
            frmform3.lstdatabase.RowSource = "SearchDataTDMS!A2:P" & iSearchRow    
            MsgBox "Records found."
           End If
        Else
              MsgBox "Records found."
        End If
        shDatabase.AutoFilterMode = False
        Application.ScreenUpdating = True
End Sub

Thank you,
Tony
 

Attachments

  • 1707851799970.png
    1707851799970.png
    96.9 KB · Views: 8

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
Hello All,

The error message moved down 3 lines. The line is marked 'Error message here.


VBA Code: 
Sub Reset3()
    Dim iRow As Long
        iRow = [Counta(DatabaseTDMS!A:A)]
        With frmform3
            .cmbTdms.Clear
            .cmbTdms.AddItem "Pre-TDMS Drawing"
            .cmbTdms.AddItem "Drawing"
            .cmbTdms.AddItem "Engineering Order"
            .cmbTdms.AddItem "Work Order Authorization"
            .cmbTdms.AddItem "Work Order Authorization Pending"
            .cmbTdms.AddItem "Work Order Authorization Deviation"
            .cmbTdms.AddItem "Work Order Authorization Continuation Sheet"
            .cmbTdms.AddItem "Work Order Authorization Event Unscheduled"
            .cmbTdms.AddItem "Data Packs"
            .cmbTdms.AddItem "Score"
            .cmbTdms.AddItem "Data Packs"
            .cmbTdms.AddItem "Specification"
            .cmbTdms.AddItem "Problem Report from TDMS"
            .cmbTdms.AddItem "Problem Report from Building 5"      
            .txtNumber.Value = " "
            .txtrev.Value = " "
            .txtsubrev = " "        
            .cmbsystem.Clear      
              .cmbsystem.AddItem "ACS"
        .cmbsystem.AddItem "Archive Data"
         .cmbsystem.AddItem "ATDS"
        .cmbsystem.AddItem "Autocapture Testbed"
         .cmbsystem.AddItem "AVN"
        .cmbsystem.AddItem "C&DH"
         .cmbsystem.AddItem "CBS"
        .cmbsystem.AddItem "COMLIDAR"
         .cmbsystem.AddItem "COMM"
        .cmbsystem.AddItem "COMSEC"
         .cmbsystem.AddItem "EGSE"
        .cmbsystem.AddItem "EGSE (Flight I&T)"
         .cmbsystem.AddItem "EPS"
        .cmbsystem.AddItem "FlatSat"
         .cmbsystem.AddItem "FSW"
        .cmbsystem.AddItem "HFCS"
         .cmbsystem.AddItem "L7 Mockups (Flight I&T)"
        .cmbsystem.AddItem "Landsat 7"
         .cmbsystem.AddItem "LIDAR"
        .cmbsystem.AddItem "MECH"
         .cmbsystem.AddItem "MGSE (Flight I&T)"
        .cmbsystem.AddItem "PCC"
         .cmbsystem.AddItem "PROP"
        .cmbsystem.AddItem "PSU"
         .cmbsystem.AddItem "PTS"
        .cmbsystem.AddItem "RDT"
         .cmbsystem.AddItem "REU"
        .cmbsystem.AddItem "ROBOT"
         .cmbsystem.AddItem "RPO"
        .cmbsystem.AddItem "RPO Testbed"
         .cmbsystem.AddItem "SC"
        .cmbsystem.AddItem "SCTHRM"
         .cmbsystem.AddItem "Servicing Payload (PYLD)"
        .cmbsystem.AddItem "Serviving Testbed"
         .cmbsystem.AddItem "Simulators"
        .cmbsystem.AddItem "SP/SV/SC SPIDER GSE"
        .cmbsystem.AddItem "Spave Vehicle Management"
        .cmbsystem.AddItem "SPIDER"
         .cmbsystem.AddItem "SPINT"
        .cmbsystem.AddItem "STR"
         .cmbsystem.AddItem "SVINT"
        .cmbsystem.AddItem "Testbeds"
         .cmbsystem.AddItem "THRM"
        .cmbsystem.AddItem "TOOL"
        .cmbsystem.AddItem "VDSU"
        .cmbsystem.AddItem "VSS"        
        .optAccept.Value = False
        .optReject.Value = False      
        .txtAuthor.Value = " "
        .txtnotes.Value = " "       
        .cmbDefect1a.Clear        
        .cmbDefect1a.AddItem "10 - Missing appropriate QA"
        .cmbDefect1a.AddItem "20 - Missing Dimensions"
        .cmbDefect1a.AddItem "30 - Incorrect drawing call outs"
        .cmbDefect1a.AddItem "40 - Missing photos"
        .cmbDefect1a.AddItem "50 - Missing reference information"
        .cmbDefect1a.AddItem "60 - Incorrect reference materials"
        .cmbDefect1a.AddItem "70 - Incorrect event code"
        .cmbDefect1a.AddItem "80 - Accept"    
        .cmbDefect1b.Clear
        .cmbDefect1b.AddItem "10 - Missing appropriate QA"
        .cmbDefect1b.AddItem "20 - Missing Dimensions"
        .cmbDefect1b.AddItem "30 - Incorrect drawing call outs"
        .cmbDefect1b.AddItem "40 - Missing photos"
        .cmbDefect1b.AddItem "50 - Missing reference information"
        .cmbDefect1b.AddItem "60 - Incorrect reference materials"
        .cmbDefect1b.AddItem "70 - Incorrect event code"
        .cmbDefect1b.AddItem "80 - Accept"     
         .cmbDefect1c.Clear      
        .cmbDefect1c.AddItem "10 - Missing appropriate QA"
        .cmbDefect1c.AddItem "20 - Missing Dimensions"
        .cmbDefect1c.AddItem "30 - Incorrect drawing call outs"
        .cmbDefect1c.AddItem "40 - Missing photos"
        .cmbDefect1c.AddItem "50 - Missing reference information"
        .cmbDefect1c.AddItem "60 - Incorrect reference materials"
        .cmbDefect1c.AddItem "70 - Incorrect event code"
        .cmbDefect1c.AddItem "80 - Accept"       
           .cmbdefect1d.Clear        
        .cmbdefect1d.AddItem "10 - Missing appropriate QA"
        .cmbdefect1d.AddItem "20 - Missing Dimensions"
        .cmbdefect1d.AddItem "30 - Incorrect drawing call outs"
        .cmbdefect1d.AddItem "40 - Missing photos"
        .cmbdefect1d.AddItem "50 - Missing reference information"
        .cmbdefect1d.AddItem "60 - Incorrect reference materials"
        .cmbdefect1d.AddItem "70 - Incorrect event code"
        .cmbdefect1d.AddItem "80 - Accept"   
         .cmbdefect2a.Clear       
         .cmbdefect2a.AddItem "10 - Missing appropriate QA"
         .cmbdefect2a.AddItem "20 - Missing dimensions"
         .cmbdefect2a.AddItem "30 - Incorrect drawing call outs"
         .cmbdefect2a.AddItem "40 - Missing photos"
         .cmbdefect2a.AddItem "50 - Missing reference information"
         .cmbdefect2a.AddItem "60 - Incorrect reference materials"
         .cmbdefect2a.AddItem "70 - Incorrect event code"
         .cmbdefect2a.AddItem "80 - Deviation required"
         .cmbdefect2a.AddItem "90 - PR required"
         .cmbdefect2a.AddItem "100 - Accept"      
         .txtRowNumber.Value = " "         
         'Below code are associated with Search Feature - Part 3         
         Call Add_SearchColumn3
         ThisWorkbook.Sheets("DatabaseTDMS").AutoFilterMode = False
         ThisWorkbook.Sheets("SearchDataTDMS").AutoFilterMode = False
         ThisWorkbook.Sheets("SearchDataTDMS").Cells.Clear         
         '----------------------------------------------------------
        .lstdatabase.ColumnCount = 16
        .lstdatabase.ColumnHeads = True        
        .lstdatabase.ColumnWidths = "20,50,40,20,20,40,10,40,40,40,40,40,40,30,40,40"        
        If iRow > 1 Then     
            .lstdatabase.RowSource = "DatabaseTDMS!A2:P" & iRow            
        Else
            .lstdatabase.RowSource = "DatabaseTDMS!A2:P2"
        End If        
    End With   
End Sub

Sub Submit3()
    Dim Sh As Worksheet
    Dim iRow As Long    
    Set Sh = ThisWorkbook.Sheets("DatabaseTDMS")    
    If frmform3.txtRowNumber.Value = " " Then      
    iRow = [Counta(DatabaseTDMS!A:A)] + 1       
    Else     
      iRow = frmform3.txtRowNumber.Value
    End If          
    With Sh   
        .Cells(iRow, 1) = iRow - 1     
        .Cells(iRow, 2) = frmform3.cmbTdms.Value        
        .Cells(iRow, 3) = frmform3.txtNumber.Value        
        .Cells(iRow, 4) = frmform3.txtrev.Value       
        .Cells(iRow, 5) = frmform3.txtsubrev.Value        
        .Cells(iRow, 6) = frmform3.cmbsystem.Value        
        .Cells(iRow, 7) = IIf(frmform3.optAccept.Value = True, "A", "R")       
        .Cells(iRow, 8) = frmform3.txtAuthor.Value      
        .Cells(iRow, 9) = frmform3.txtnotes.Value      
        .Cells(iRow, 10) = frmform3.cmbDefect1a.Value       
        .Cells(iRow, 11) = frmform3.cmbDefect1b.Value        
        .Cells(iRow, 12) = frmform3.cmbDefect1c.Value    
        .Cells(iRow, 13) = frmform3.cmbdefect1d.Value        
        .Cells(iRow, 14) = frmform3.cmbdefect2a.Value        
        .Cells(iRow, 15) = Application.userName
        .Cells(iRow, 16) = [Text(Now(), "MM-DD-YYYY HH:MM:SS")]
    End With      
 End Sub
 
Sub Show_Form3()
    frmform3.Show
    End Sub
    
Function Selected_List3() As Long
    Dim i As Long
    Selected_List3 = 0
    For i = 0 To frmform3.lstdatabase.ListCount - 1
       If frmform3.lstdatabase.Selected(i) = True Then
       Selected_List3 = i + 1
       Exit For
      End If
    Next i
End Function

Sub Add_SearchColumn3()
    frmform3.EnableEvents = False
    With frmform3.cmbSearchColumn
        .Clear
        .AddItem "All"
        .AddItem "Type"
        .AddItem "Doc Num"
        .AddItem "Rev"
        .AddItem "Sub Rev"
        .AddItem "System"
        .AddItem "AcceptReject"
        .AddItem "Author"
        .AddItem "Notes"
        .AddItem "Defect Code 1a"
        .AddItem "DC 1b"
        .AddItem "DC 1c"
        .AddItem "DC 1d"
        .AddItem "DC 2a"
        .AddItem "QE"
        .AddItem "Date"        
        .Value = "All"
    End With           
       frmform3.EnableEvents = True    
       frmform3.txtSearch.Value = " "
       frmform3.txtSearch.Enabled = False
       frmform3.cmdSearch.Enabled = False           
End Sub
Sub SearchData3()
    Application.ScreenUpdating = False    
    Dim shDatabase As Worksheet 'Database Sheet    
    Dim shSearchData As Worksheet 'SearchData Sheet
    Dim iColumn As Integer 'To hold the selected column number in Database sheet
    Dim iDatabaseRow As Long 'To store the last non-blank row number avaliable in SearchData sheet
    Dim iSearchRow As Long 'To hold the last non-blank row number available in SearchDate Sheet    
    Dim sColumn As String 'To store the column selection
    Dim sValue As String 'To hold the search text value    
    Set shDatabase = ThisWorkbook.Sheets("DatabaseTDMS")
    Set shSearchData = ThisWorkbook.Sheets("SearchDataTDMS")   
    iDatabaseRow = ThisWorkbook.Sheets("DatabaseTDMS").Range("A" & Application.Rows.Count).End(xlUp).Row   
    sColumn = frmform3.cmbSearchColumn.Value
    sValue = frmform3.txtSearch.Value
    iColumn = Application.WorksheetFunction.Match(sColumn, shDatabase.Range("A1:P1"), 0)     'ERROR MESSAGE HERE
    'Remove filter from DatabaseTDMS worksheet
       If shDatabase.AutoFilterMode = True Then
       shDatabase.AutoFilterMode = False
    End If
    'Apply filter on databaseTDMS worksheet
    If frmform3.cmbSearchColumn.Value = "Type" Then   
        shDatabase.Range("A1:P" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:=sValue
    Else
        shDatabase.Range("A1:P" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:="*" & sValue & "*"
    End If
       If Application.WorksheetFunction.Subtotal(3, shDatabase.Range("C:C")) >= 2 Then
       'Code to remove the previous data from SeachData worksheet
        shSearchData.Cells.Clear  
        shDatabase.AutoFilter.Range.Copy shSearchData.Range("A1")
        Application.CutCopyMode = False
        iSearchRow = shSearchData.Range("A" & Application.Rows.Count).End(xlUp).Row
        frmform3.lstdatabase.ColumnCount = 16
        frmform3.lstdatabase.ColumnWidths = "40,40,40,40,40,40,40,40,40,40,40,40,40,40,40,40"
        If iSearchRow > 1 Then
            frmform3.lstdatabase.RowSource = "SearchDataTDMS!A2:P" & iSearchRow    
            MsgBox "Records found."
           End If
        Else
              MsgBox "Records found."
        End If
        shDatabase.AutoFilterMode = False
        Application.ScreenUpdating = True
End Sub

Thank you,
Tony
 
Upvote 0
aabrazil1 said:
Thank you Domenic!
Click to expand...
The marked solution has been changed accordingly. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.


aabrazil1 said:
The error message moved down 3 lines. The line is marked 'Error message here.
Click to expand...
.. but what is the full error message now?
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Cannot enter text in textbox on form
Replies
3
Views
281
Anthony47
A
E
  • Question Question
Search function not finding rows containing the matching value
Replies
1
Views
678
GlennUK
G
J
  • Question Question
VBA Code Help - Search Form
Replies
1
Views
1K
James006
James006
A
  • Question Question
Run-time error '380' Could not set the Value property. Invalid property value
Replies
7
Views
898
aabrazil1
A
A
  • Question Question
Autofilter code based on username
Replies
1
Views
374
aabrazil1
A

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top