Question

For search in one column (column B) i use this code

Private Sub TextBox1_Change()

txt = TextBox1.Text
lt = Len(TextBox1.Text)
If lt = 0 Then Exit Sub

x = Range("b1", Cells(Rows.Count, 1).End(xlUp)).Value

For i = 1 To UBound(x, 1)
    If InStr(x(i, 2), txt) Then
            s = s & "~" & x(i, 1) & "         >>>>" & x(i, 2)

    Else
    End If
Next i

ListBox1.List = Split(Mid(s, 2), "~")
End Sub

But how to change this code to look for txt in some column (Column B and Column A) or (Column B and Column A and Column C) at once?

so if i have

in column A 
first
second
thirdFirst

in column B
notfirst
secondFirst
third

with this code i look only in column B and get

if txt= first
result
first notfirst
second secondFirst

but i cant find thirdFist values from column A so i need get result like

if txt= first
result
first notfirst
second secondFirst
thirdFirst third
Was it helpful?

Solution

Ok, so I hope I understood your question right. Here example of code and the result for sample data on the picture. HTH.

Option Explicit

Private Sub CommandButton1_Click()
    Dim txt, values, valuesFiltered, r, c, rowsCount, columnsCount, check

    txt = "first"
    If Len(txt) = 0 Then _
        Exit Sub

    ' get all values from last used cell in column 'A' to upperRightCell
    ' e.g. "B1', 'C1' etc.
    Dim lastUsedCellInColumn_A As Range
    Set lastUsedCellInColumn_A = Cells(Rows.Count, 1).End(xlUp)

    Dim upperRightCell As Range
    Set upperRightCell = Range("C1")

    values = Range(lastUsedCellInColumn_A, upperRightCell).Value
    rowsCount = UBound(values, 1)
    columnsCount = UBound(values, 2)

    If columnsCount <= 1 Then _
        Err.Raise 12345, , "At least two columns must be used."

    For r = 1 To rowsCount
        For c = 1 To columnsCount

            If InStr(values(r, c), txt) = 0 Then _
                GoTo next_column

            If c > 1 Then
                ' columns B, C, D and so on: take value from neighbour cell on the left
                check = values(r, c) & ">>>>" & values(r, c - 1)
            Else
                ' column A: take value from neighbour cell on the right
                check = values(r, c + 1) & ">>>>" & values(r, c)
            End If

            ' do not add duplicate values
            If IsArray(valuesFiltered) = False Then
                ReDim valuesFiltered(0)
                valuesFiltered(0) = check
            Else
                If UBound(Filter(valuesFiltered, check)) = -1 Then
                    ReDim Preserve valuesFiltered(UBound(valuesFiltered) + 1)
                    valuesFiltered(UBound(valuesFiltered)) = check
                End If
            End If

next_column:
        Next c
    Next r

    If Not IsEmpty(valuesFiltered) Then _
        ListBox1.List = valuesFiltered
End Sub

enter image description here

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top