View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.misc
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default 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