Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Custom Data Validation : Lock if MyCell = ""? | Excel Worksheet Functions | |||
Item numbers result in item description in next field in Excel | Excel Worksheet Functions | |||
UserForm:Resume to ListBox1 | Excel Discussion (Misc queries) | |||
delete entirerow if date more than 12months old | Excel Discussion (Misc queries) | |||
Help with: ListBox1.AddItem (ws.Name) | Excel Worksheet Functions |