Excel Forum

Code: Select all

Private Sub TextBox1_Change()
Dim i As Long
ListBox1.Clear
Me.ListBox1.AddItem
   For X = 1 To 7
     Me.ListBox1.List(0, X - 1) = Sheet1.Cells(1, X)
   Next X
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Len(Me.TextBox1.Text)
If StrConv(Left(Sheet1.Cells(i, 1).Value, a), vbLowerCase) = StrConv(Left(Me.TextBox1.Text, a), vbLowerCase) Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
End If
Next i
End Sub

Private Sub TextBox2_Change()
Dim i As Long
ListBox1.Clear
Me.ListBox1.AddItem
   For X = 1 To 7
     Me.ListBox1.List(0, X - 1) = Sheet1.Cells(1, X)
   Next X
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Len(Me.TextBox2.Text)
If StrConv(Left(Sheet1.Cells(i, 2).Value, a), vbLowerCase) = StrConv(Left(Me.TextBox2.Text, a), vbLowerCase) Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
End If
Next i

End Sub

Private Sub TextBox3_Change()
Dim i As Long
ListBox1.Clear
Me.ListBox1.AddItem
   For X = 1 To 7
     Me.ListBox1.List(0, X - 1) = Sheet1.Cells(1, X)
   Next X
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Len(Me.TextBox3.Text)
If StrConv(Left(Sheet1.Cells(i, 3).Value, a), vbLowerCase) = StrConv(Left(Me.TextBox3.Text, a), vbLowerCase) Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
End If
Next i
End Sub

Private Sub TextBox4_Change()
Dim i As Long
ListBox1.Clear
Me.ListBox1.AddItem
   For X = 1 To 7
     Me.ListBox1.List(0, X - 1) = Sheet1.Cells(1, X)
   Next X
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Len(Me.TextBox4.Text)
If StrConv(Left(Sheet1.Cells(i, 4).Value, a), vbLowerCase) = StrConv(Left(Me.TextBox4.Text, a), vbLowerCase) Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
End If
Next i
End Sub

Private Sub TextBox5_Change()
Dim i As Long
ListBox1.Clear
Me.ListBox1.AddItem
   For X = 1 To 7
     Me.ListBox1.List(0, X - 1) = Sheet1.Cells(1, X)
   Next X
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Len(Me.TextBox5.Text)
If StrConv(Left(Sheet1.Cells(i, 5).Value, a), vbLowerCase) = StrConv(Left(Me.TextBox5.Text, a), vbLowerCase) Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
End If
Next i
End Sub

Private Sub TextBox6_Change()
Dim i As Long
ListBox1.Clear
Me.ListBox1.AddItem
   For X = 1 To 7
     Me.ListBox1.List(0, X - 1) = Sheet1.Cells(1, X)
   Next X
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Len(Me.TextBox6.Text)
If StrConv(Left(Sheet1.Cells(i, 6).Value, a), vbLowerCase) = StrConv(Left(Me.TextBox6.Text, a), vbLowerCase) Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
End If
Next i
End Sub

Private Sub TextBox7_Change()
Dim i As Long
ListBox1.Clear
Me.ListBox1.AddItem
   For X = 1 To 7
     Me.ListBox1.List(0, X - 1) = Sheet1.Cells(1, X)
   Next X
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Len(Me.TextBox7.Text)
If StrConv(Left(Sheet1.Cells(i, 7).Value, a), vbLowerCase) = StrConv(Left(Me.TextBox7.Text, a), vbLowerCase) Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
End If
Next i

End Sub

Code: Select all

Private Sub TextBox1_AfterUpdate()
    Dim i As Long
    Dim strRange As String
    Dim strTextSearch As String
    Dim a() As Variant
    Dim k As Integer
    Dim j As Integer
    Dim rall As Range
    Dim r As Range
    
    ListBox1.Clear
    If TextBox1.Text <> "" Then
        strTextSearch = TextBox1.Text
        ReDim Preserve a(k)
        a(k) = 1
        k = k + 1
    End If
    If TextBox2.Text <> "" Then
        strTextSearch = strTextSearch & TextBox2.Text
        ReDim Preserve a(k)
        a(k) = 2
        k = k + 1
    End If
    If TextBox3.Text <> "" Then
        strTextSearch = strTextSearch & TextBox3.Text
        ReDim Preserve a(k)
        a(k) = 3
        k = k + 1
    End If
    'Other remaining Textbox code
    For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
        For j = 0 To UBound(a)
            strRange = strRange & Range("a" & i).Offset(0, j).Value
        Next j
        If strTextSearch = strRange Then
            With Me.ListBox1
                .AddItem Sheet1.Cells(i, 1).Value
                .List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
                .List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
                .List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
                .List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
                .List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
                .List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
            End With
        End If
    Next i
End Sub