This code evolved from the one above it is called by a worksheet specific change event.
ie if any specified cells are changed and the length of one of those cells is 3 or more characters.
Then the subroutine is called using a parameter that specifies the string to search for
Sub Populate(strValueToPick As String)
Dim rngPicked As Range
Sheets("Customer database").Select
LR = Range("A1").End(xlDown).Offset(1, 0).Row
Range("A1:G" & LR).Select' We are now searching 7 columns.
Set rngLook = Selection
With rngLook
Set rngFind = .Find(strValueToPick, .Cells(1, 1), LookIn:=xlValues, lookat:=xlPart)
If Not rngFind Is Nothing Then
strFirstAddress = rngFind.Address
Set rngPicked = rngFind
Do
Set rngPicked = Union(rngPicked, rngFind)
Set rngFind = .FindNext(rngFind)
Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
End If
End With
On Error Resume Next
rngPicked.Select
If InStr(LCase(ActiveCell.Value), LCase(strValueToPick)) = 0 Then Range("A1").Select: Exit Sub
Count = 0
' So every occurrance of our test string has been selected
'To speed things up read all 8 columns of data for each entry into TESTSTRING
For Each c In Selection
entry = c.Row
teststring = ""
For Count = 1 To 8
teststring = teststring & Cells(entry, Count)
Next
' I am allowing the user to type search text into the range of cells C8:G12
' So if Teststring contains all the text that appears in C8:G12 the I want it displayed in my listbox
AddItemFlag = True
For RowNo = 8 To 12
For ColNo = 3 To 7
If Len(Sheets("Invoice").Cells(RowNo, ColNo).Text) > 0 And InStr(1, teststring, Sheets("Invoice").Cells(RowNo, ColNo).Text, 1) = 0 Then AddItemFlag = False
Next ColNo
Next RowNo
Changeflag = 1
If AddItemFlag = True Then Sheets("Invoice").ListBox1.AddItem c.Row - 1 & " " & Cells(c.Row, 1).Value & " " & Cells(c.Row, 2).Value & " " & Cells(c.Row, 3).Value & ": " & Cells(c.Row, 4).Value & ", " & Cells(c.Row, 5).Value & ", " & Cells(c.Row, 7).Value
Changeflag = 0
20 Next c
End Sub
Bookmarks