ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   ListBox1. add item myCell.entirerow (https://www.excelbanter.com/excel-discussion-misc-queries/182801-listbox1-add-item-mycell-entirerow.html)

Vikram Dhemare
ListBox1. add item myCell.entirerow
 
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
ListBox1. add item myCell.entirerow
 
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
ListBox1. add item myCell.entirerow
 
Building the array may be easier to do:

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 cCtr As Long
Dim DestCell As Range
Dim PrevRow As Long
Dim myArr() As Variant
Dim aCtr As Long
WhatToSearchFor = Me.TextBox1.Value

Me.ListBox1.Clear

With BOMWks
Set RngToSearch = .Cells
End With

Application.ScreenUpdating = False

aCtr = 0
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
aCtr = aCtr + 1
ReDim Preserve myArr(1 To LastCol, 1 To aCtr)

'copy the row to tempwks
For cCtr = 1 To LastCol
myArr(cCtr, aCtr) _
= FoundCell.EntireRow.Cells(1).Offset(0, cCtr - 1)
Next cCtr
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 = Application.Transpose(myArr)
.Enabled = True
End With

End If
End With

With Application
.ScreenUpdating = True
.CutCopyMode = False
End With

End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub TextBox1_Change()
Me.CommandButton1.Enabled = CBool(Trim(Me.TextBox1.Value) < "")
End Sub
Private Sub UserForm_Initialize()

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

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

Dave Peterson
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


All times are GMT +1. The time now is 07:40 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com