I have on my web site a VBA procedure named FindAll which will find
all occurrences of a value in a range an return a range object
containing all the cells in which the value was found. See
http://www.cpearson.com/excel/findall.aspx or download, unzip, and
import
http://www.cpearson.com/Zips/modFindAll.zip . Once you have the
FindAll function in your project, you can do something like the
following:
Dim FoundCells As Range
Dim R As Range
Dim N As Long
Set founcells = FindAll(SearchRange:=KH_Range, _
FindWhat:=M, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, MatchCase:=False)
If Not FoundCells Is Nothing Then
For Each R In FoundCells
listbox1.AddItem
For N = 0 To 5
listbox1.List(w, N) = R.EntireRow.Cells(1, N + 1).Value
End If
w = w + 1
Next R
End If
Cordially,
Chip Pearson
Microsoft MVP 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
[email on web site]
On Sat, 5 Dec 2009 04:31:28 -0800 (PST), "abu
(E-Mail Removed)" <(E-Mail Removed)> wrote:
>I Have This Code To Run Search By User Form With Textbox To Enter
>Search Text Then Return Result On 6 Columns Listbox , Code Working Ok
>BuT Sometimes If Too Much Data It Takes A Long Time , If Can Be Beter
>Code I will Be Very Grateful .
>thanks
>
>Private Sub TextBox1_Change()
>On Error Resume Next
>Dim KH_Range As Range
>Dim M As String
>Set KH_Range = Range("ITEMS_INFO")
>M = TextBox1.Text
>ListBox1.Clear
>If M = "" Then GoTo 1
>W = ListBox1.ListCount
> With KH_Range
> KH_1 = .Rows.Count
> KH_2 = .Columns.Count
> Set A = Range(.Cells(1, 1), .Cells
>(.Rows.Count, .Columns.Count)).Find(M)
> If Not A Is Nothing Then
> F = A.Address
> Do
>
> ListBox1.AddItem
> ListBox1.List(W, 0) = Sheet2.Cells(A.Row, 1).Value
> ListBox1.List(W, 1) = Sheet2.Cells(A.Row, 2).Value
> ListBox1.List(W, 2) = Sheet2.Cells(A.Row, 3).Value
> ListBox1.List(W, 3) = Sheet2.Cells(A.Row, 4).Value
> ListBox1.List(W, 4) = Sheet2.Cells(A.Row, 5).Value
> ListBox1.List(W, 5) = Sheet2.Cells(A.Row, 6).Value
>
> W = W + 1
>
>
> Set A = Range(.Cells(1, 1), .Cells(KH_1, KH_2)).FindNext(A)
> Loop While Not A Is Nothing And A.Address <> F
> End If
> End With
>Set A = Nothing
>1 End Sub
Similar Threads
