0

Upated: 12:23AM - Working Code

I am currently stuck. Right now it is inserting only the last occurrence of the found result and I want it to put all of them separately into the list box, but I cannot seem to figure it out no matter how I try. I have tried to use AddItem, Range, Text, Value, all kinds of tricks I found on Google to make it work, but all I get are Errors or just one Entry... Here is what I have so far. The Me. stuff is part of my Userform which are all text boxes, everything being pulled from Excel is general and has no specific type.

This is all of my code for this button. My issues is in the Search_Click Sub, but it may be other places so I gave the entire code. Let me know if you need any more information. There are no tables in the excel document and nothing fancy just a range of cells with some info set up like this. Each a column

Jewelry Description Date Officer Time Date(Returned) Officer(Returned) Time(Returned) Returned

Option Explicit
Dim wb As Workbook
Dim ws As Worksheet


Private Sub CommandButton1_Click()
  Dim i As Integer, sht As String
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            sht = ListBox1.List(i)
        End If
    Next i
    If (sht <> "") Then
    Set ws = wb.Worksheets(sht)
    Else
    MsgBox "Please Choose a Sheet"
    End If
End Sub

Private Sub Userform_Initialize()
    Set wb = Workbooks.Open("\\rh-utility03\home\bquigley\Book2.xlsx")
    ListBox1.Clear
End Sub

Private Sub Userform_Activate()
 Me.Jewelry.Value = ""
    Me.Description.Value = ""
    Me.Date_In.Value = ""
    Me.Officer_In.Value = ""
    Me.Time_In.Value = ""
    Me.Date_Out.Value = ""
    Me.Officer_Out.Value = ""
    Me.Time_Out.Value = ""
    Me.Returned.Value = ""
    Dim i As Integer, sht As String
    For Each ws In wb.Worksheets
    ListBox1.AddItem (ws.Name)
    Next ws
End Sub

Private Sub Clear_Click()
 Me.Jewelry.Value = ""
    Me.Description.Value = ""
    Me.Date_In.Value = ""
    Me.Officer_In.Value = ""
    Me.Time_In.Value = ""
    Me.Date_Out.Value = ""
    Me.Officer_Out.Value = ""
    Me.Time_Out.Value = ""
    Me.Returned.Value = ""
End Sub

Private Sub Search_Click()
    'Copy input values to sheet.
    Dim lRow As Long
    Dim rStr As String
    Dim lngLastRow As Long
    Dim lngRow As Long
    Dim strValue As String
    Dim lngRowOutput As Long
    Dim i As Long
    ' where does the data end in the Worksheet
    lngLastRow = ws.UsedRange.Rows.Count

    If lngLastRow = 1 Then Exit Sub ' no data
    Me.Results.Clear
    lngRowOutput = 2 ' where are we going to write the values to in Results List when we find a phrase
    i = 0
    For lngRow = 2 To lngLastRow
    If (Me.Description.Value <> "") Then
        strValue = ws.Cells(lngRow, 3).Value ' get value from column C
        If InStr(1, strValue, Me.Description.Value, vbTextCompare) > 0 Then ' can we find the string in the text
           With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)

           End With
            i = i + 1
            End If
    ElseIf (Me.Officer_In.Value <> "") Then
    strValue = ws.Cells(lngRow, 5).Value ' get value from column C
    If InStr(1, strValue, Me.Officer_In.Value, vbTextCompare) > 0 Then ' can we find the string in the text
             With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
            i = i + 1
        End If
        ElseIf (Me.Officer_Out.Value <> "") Then
    strValue = ws.Cells(lngRow, 8).Value ' get value from column C
    If InStr(1, strValue, Me.Officer_Out.Value, vbTextCompare) > 0 Then ' can we find "MOTOR" in the text
             With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
            i = i + 1
        End If
        ElseIf (Me.Time_In.Value <> "") Then
    strValue = ws.Cells(lngRow, 6).Value ' get value from column C
    If InStr(1, strValue, Me.Time_In.Text, vbTextCompare) > 0 Then ' can we find "MOTOR" in the text
             With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
           i = i + 1
        End If
        ElseIf (Me.Time_Out.Value <> "") Then
    strValue = ws.Cells(lngRow, 9).Value ' get value from column C
    If InStr(1, strValue, Me.Time_Out.Text, vbTextCompare) > 0 Then ' can we find "MOTOR" in the text
             With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
            i = i + 1
        End If
        ElseIf (Me.Date_In.Value <> "") Then
    strValue = ws.Cells(lngRow, 4).Text ' get value from column C
    If InStr(1, strValue, Me.Date_In.Value, vbTextCompare) > 0 Then ' can we find "MOTOR" in the text
             With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
           i = i + 1
        End If
        ElseIf (Me.Date_Out.Value <> "") Then
    strValue = ws.Cells(lngRow, 7).Text ' get value from column C
    If InStr(1, strValue, Me.Date_Out.Value, vbTextCompare) > 0 Then ' can we find "MOTOR" in the text
             With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
           i = i + 1
        End If
        ElseIf (Me.Returned.Value <> "") Then
    strValue = ws.Cells(lngRow, 10).Value ' get value from column C
    If InStr(1, strValue, Me.Officer_In.Value, vbTextCompare) > 0 Then ' can we find "MOTOR" in the text
             With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
           i = i + 1
        End If
    Else
         With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
           i = i + 1
        End If
    Next lngRow
End Sub

Private Sub Modify_Click()
    'Copy input values to sheet.
    Dim lRow As Long
    Dim ws As Worksheet
    Dim RowToModify As Long
    Set ws = wb.Worksheets(1)
    If (Me.Results.ListIndex <> -1 And Me.Results.Value <> "") Then
    RowToModify = Me.Results.Value
    Else: MsgBox "Select a Result to Modify"
    End If
    lRow = RowToModify + 1
    With ws
        Me.Jewelry.Value = .Cells(lRow, 2).Value
        Me.Description.Value = .Cells(lRow, 3).Value
        Me.Date_In.Value = .Cells(lRow, 4).Value
        Me.Officer_In.Value = .Cells(lRow, 5).Value
        Me.Time_In.Value = .Cells(lRow, 6).Value
        Me.Date_Out.Value = .Cells(lRow, 7).Value
        Me.Officer_Out.Value = .Cells(lRow, 8).Value
        Me.Time_Out.Value = .Cells(lRow, 9).Value
        Me.Returned.Value = .Cells(lRow, 10).Value
    End With
    'Clear input controls.
End Sub

Private Sub Submit_Click()
    'Copy input values to sheet.
    Dim lRow As Long
    Dim ws As Worksheet
    Dim RowToModify As Long
    Set ws = wb.Worksheets(1)
     If (Me.Results.ListIndex <> -1) Then
    RowToModify = Me.Results.Value
    Else: MsgBox "Select a Result to Modify"
    End If
    lRow = RowToModify + 1
    With ws
        .Cells(lRow, 1).Value = RowToModify
        .Cells(lRow, 2).Value = Me.Jewelry.Value
        .Cells(lRow, 3).Value = Me.Description.Value
        .Cells(lRow, 4).Value = Me.Date_In.Value
        .Cells(lRow, 5).Value = Me.Officer_In.Value
        .Cells(lRow, 6).Value = Me.Time_In.Value
        .Cells(lRow, 7).Value = Me.Date_Out.Value
        .Cells(lRow, 8).Value = Me.Officer_Out.Value
        .Cells(lRow, 9).Value = Me.Time_Out.Value
        .Cells(lRow, 10).Value = Me.Returned.Value
    End With
    End Sub
Private Sub CloseButton_Click()
    'Close UserForm.
    Workbooks.Application.ActiveWorkbook.Save
    Workbooks.Application.ActiveWorkbook.Close
    Unload Me
End Sub
Brandon Q
  • 3
  • 3
  • The command `Me.Results.List = Arr` if wrong for `Arr` is not assigned any value. Treat a listbox like a variant array that you can expand with `.AddItem` or overwrite with `.List = Arr`. You can copy the whole content with `Arr = Me.Results.List`, manipulate it and load it back (replace the whole content of) the listbox with `Me.Results.List = Arr` if it is more convenient. As you work with multiple columns, you need a specific syntax, see e.g. this: https://stackoverflow.com/questions/11213962/vba-listbox-multicolumn-add/11222439 – AcsErno Jan 27 '20 at 07:58
  • so assign Arr to Me.Results.List and use that to gather the data? I was having issues using AddItem as it kept giving me invalid property index no matter what I used in the index field or a mismatch type if I got it past that point. I am heading home for my weekend but will try this on Wednesday. I will update the post whether I fail or succeed. – Brandon Q Jan 27 '20 at 08:08
  • "Invalid property" might come from wrong index. Treat the listbox as an array - 2 dimensional in this case - like `Results(0 To .Listcount - 1, 0 To .ColumnCount - 1)`, and if you want to resize it then either use `.AddItem` or `.RemoveItem`, or completely overwrite it with `Results.List = Arr`. For setting a value in row n column m use `.Result.List(n - 1, m - 1) = ` – AcsErno Jan 27 '20 at 11:38
  • Thank you for all of your help AcsErno. After some more fooling around with it I found a solution and added/changed some functionality. – Brandon Q Jan 30 '20 at 08:24

1 Answers1

0

I figured it out. The updated and working code is above in my original question. I was trying to add multiple items using one .List =

I was not realizing I had 10 columns that all needed to be filled in separately.

Brandon Q
  • 3
  • 3