ListBox1. add item myCell.entirerow
ps. this line can be deleted:
dim iCol as long
Dave Peterson wrote:
First, you can't use .additem and have this many columns.
One way around it is to copy the rows to a different (temporary) worksheet and
pick up the values from that worksheet. (Another way would be to build an array
as you find the matches.)
I chose the first version.
I create a small userform with a listbox, a textbox and two commandbuttons on
it.
This is the code behind the userform:
Option Explicit
Dim LastCol As Long
Dim BOMWks As Worksheet
Dim TempWks As Worksheet
Private Sub CommandButton1_Click()
Dim RngToSearch As Range
Dim FirstAddress As String
Dim WhatToSearchFor As String
Dim FoundCell As Range
Dim iCol As Long
Dim DestCell As Range
Dim PrevRow As Long
WhatToSearchFor = Me.TextBox1.Value
Me.ListBox1.Clear
With BOMWks
Set RngToSearch = .Cells
End With
Set DestCell = TempWks.Range("A1")
Application.ScreenUpdating = False
With RngToSearch
Set FoundCell = .Cells.Find(what:=WhatToSearchFor, _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
MatchByte:=False)
If FoundCell Is Nothing Then
MsgBox "not found!"
Beep
Else
FirstAddress = FoundCell.Address
PrevRow = -1
Do
If FoundCell.Row = PrevRow Then
'skip this one, it's on the same row
Else
PrevRow = FoundCell.Row
'copy the row to tempwks
FoundCell.EntireRow.Resize(1, LastCol).Copy
DestCell.PasteSpecial Paste:=xlPasteValues
DestCell.PasteSpecial Paste:=xlPasteFormats
Set DestCell = DestCell.Offset(1, 0)
End If
'look for the next one
Set FoundCell = .FindNext(after:=FoundCell)
If FoundCell Is Nothing Then
Exit Do
End If
If FoundCell.Address = FirstAddress Then
Exit Do
End If
Loop
With Me.ListBox1
.List = TempWks.UsedRange.Value
.Enabled = True
End With
End If
End With
With Application
.ScreenUpdating = True
.CutCopyMode = False
End With
End Sub
Private Sub CommandButton2_Click()
Call CleanUpTempWks
Unload Me
End Sub
Private Sub TextBox1_Change()
Me.CommandButton1.Enabled = CBool(Trim(Me.TextBox1.Value) < "")
End Sub
Private Sub UserForm_Initialize()
Call CleanUpTempWks
Set TempWks = Worksheets.Add
With TempWks
.Name = "Temp"
.Visible = xlSheetHidden
End With
Set BOMWks = Worksheets("bom")
With BOMWks
LastCol = .Range("P1").Column
End With
With Me.CommandButton1
.Default = True
.Caption = "Search"
.Enabled = False
End With
With Me.CommandButton2
.Cancel = True
.Caption = "Cancel"
End With
With Me.ListBox1
.Enabled = False
.MultiSelect = fmMultiSelectSingle
.ColumnCount = LastCol
End With
End Sub
Private Sub CleanUpTempWks()
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Temp").Delete
On Error GoTo 0
Application.DisplayAlerts = True
End Sub
Vikram Dhemare wrote:
Hello Everybody,
I have created a userform wherein I developed a listbox that searches the
textbox value through out the entire sheet. The answer should be If the value
found, then entire row upto column P should display in list box. could
anybody help me to come out this problem. Not getting the results:
If OptEntire = True Then
Set cRng = sh.UsedRange
Set cell = cRng.Find( _
What:=frmBoM.txtSearch, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not cell Is Nothing Then
sAddr = cell.Address
Do
LastCol = (P)
With Worksheets("BOM")
Set myList = Range(Cells(cell, 1), Cells(cell, LastCol))
End With
With frmBoM.ListBox1
.ColumnCount = 6
.AddItem myList
End With
Set cell = cRng.FindNext(cell)
Loop While cell.Address < sAddr
End If
--
Thanks,
Vikram P. Dhemare
--
Dave Peterson
--
Dave Peterson
|