PDA

View Full Version : [SOLVED:] Listbox help



Aranell
10-28-2013, 08:58 AM
Hi folks, I have

First issue
How to set a range by finding 2 different value in 2 different column
I know how to do it with one value
"
Set rng = .Columns(9).Find(what:="Test", LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False, After:=Range("I1"))"

I now need to set it also with a second word "yes" in columns(12) in "M"

So I need to search for "Test" in column "I" as well as for the word "yes" in column "M"

Second
I have a combo List box which use as another excel file as source. Example the file is called "Source.xls"
I've set the ListBox to show only Column A from the source file.
Now I need to be able to select one or multiple value in the Listbox and than by clicking on a button to export/copy the complete row from the source file ("Source.xls") based on the selected value from the listbox to an other sheet
Example the source file "Source.xls" has 3 column A, B and C
the List box show only Column A
I need by selecting the second value in the listbox which is actually A2 from the source file and than clicking on a button to copy A2, B2 and C2 in an other sheet

ans same if i selected the First, second and 4th value from the Listbox (A1, A2 and A4) to copy than A1,B1, C1 and A2, B2, C2 and A4,B4, C4 to an other sheet

p45cal
10-28-2013, 09:31 AM
First 'issue':
try:
Sub hhhh()
Dim Rng As Range
With ActiveSheet
Set Rng = .Columns(9).Find(what:="Test", LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False, After:=Range("I1"))
If Not Rng Is Nothing Then
firstaddress = Rng.Address
Do While Not Rng Is Nothing
If Rng.Offset(, 4).Value = "Yes" Then
Exit Do
Else
Set Rng = .Columns(9).FindNext(Rng)
If Rng.Address = firstaddress Then
Set Rng = Nothing
Exit Do
End If
End If
Loop
End If
If Rng Is Nothing Then
MsgBox "not found"
Else
Rng.Select ' to show found cell.
End If
End With
End Sub
I'm sure it could be shorter/slicker!


Second: You will have set the list box's multiselect properrty to 1 or 2, so you will have to iterate from 0 to listcount-1, checking the .selected property of each.
Then if it is selected you could immediately copy:
Worbooks("Source.xls").sheets("theSheetNameHere").range("A" & listbox.listindex+1).resize(,3).copy Destination:= wherever

or you could create a range with
Dim StuffToCopy as range
if StuffToCopy is nothing then Set StuffToCopy=Worbooks("Source.xls").sheets("theSheetNameHere").range("A" & listbox.listindex+1).resize(,3) else set StuffToCopy = Union(StuffToCopy,Worbooks("Source.xls").sheets("theSheetNameHere").range("A" & listbox.listindex+1).resize(,3))

and later, loops completed:
StuffToCopy.copy Destinaton:=wherever

Aranell
10-30-2013, 01:35 AM
Thanks,
your help for the second issue helped. But unfortunately for the first it didn't work
it just can't find any result always "not found"

Aranell
10-30-2013, 02:21 AM
Ok I found the error :o:, in my Source file the entire word "yes" was written on lower-case and the code was searching for "Yes".
But still it's not working as it should, it shows me only the first found "yes" and ignore the rest.
To easy for me the work I marked the result in yellow

If Rng.Offset(, 4).Value = "yes" Then
Rng.Interior.ColorIndex = 6
Exit Do


The problem I this is that when he find the word "yes" the code just exit the code. and than he stop the looping.
If I delete the exit Do, it keep stuck in the looping without finishing

p45cal
10-30-2013, 05:48 AM
In msg#1 you said you knew how to do something (find the first occurrence only). You wanted it also to check for one other thing (Yes in another column). The code I supplied was aimed at doing that.
Now you want it to do something more.
How to code this now depends on what do you want to do with the rows/cells once you've found them?
If there are headers above the data, you might find it easier to use Autofilter to single out the rows which fit your criteria and operate on them from there. If you were to record a macro of you doing that successfully, and post the resultant code here, we could clean it up and make it more efficient and flexible.

To cater for upper/lower case letters in yes, and even deal with a few extra errant spaces the line:
If Rng.Offset(, 4).Value = "Yes" Then
could changed to:
If application.trim(ucase(Rng.Offset(, 4).Value)) = "YES" Then
but this may not be relevant now.

Aranell
10-30-2013, 06:31 AM
Yeah what I meant is that I know how to search for one value (1 criteria) but didn't know how to search for 2 words at the same time.
Here is my code that show/add every row from my source file with the word "Test" in column "P" to a ListBox named CustomerListBox



Dim sDateiKundenListe As String, wbKundenListe As Workbook
Dim Rng As Range, strFirst As String
Dim i As Integer


CustomerListBox.Clear

sDateiKundenListe = "D:\Documents\ndalj25\Desktop\DataBase\CustomerDB.xlsx"

If CategoryComboBox.Value = "Test" Then

Application.ScreenUpdating = False
Application.StatusBar = "Loading Customer Address"
Set wbKundenListe = Application.Workbooks.Open(Filename:=sDateiKundenListe, ReadOnly:=True)
With wbKundenListe.Worksheets(1)
Set Rng = .Columns(16).Find(what:="Test", LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False, After:=Range("P1"))
If Not Rng Is Nothing Then
strFirst = Rng.Address
Do
CustomerName = .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 18))
CustomerListBox.AddItem CustomerName(1, 1)
For i = 1 To CustomerListBox.ColumnCount - 1
CustomerListBox.List(CustomerListBox.ListCount - 1, i) = CustomerName(1, i + 1)
Next
Set Rng = .Columns(16).FindNext(Rng)
Loop While Not Rng Is Nothing And strFirst <> Rng.Address
End If
End With
wbKundenListe.Close SAVECHANGES:=False
Application.ScreenUpdating = True
Application.StatusBar = False
End If

End Sub


I need that the Listbox show only the rows with the word "Test" in column "P" and the Word "yes" in column "Q"

I tried this but it show me only the first found row and not the rest:


Dim sDateiKundenListe As String, wbKundenListe As Workbook
Dim Rng As Range, strFirst As String
Dim firstaddress
Dim i As Integer


CustomerListBox.Clear

sDateiKundenListe = "D:\Documents\ndalj25\Desktop\DataBase\CustomerDB.xlsx"

Application.ScreenUpdating = False
Application.StatusBar = "Loading Customer Address"
Set wbKundenListe = Application.Workbooks.Open(Filename:=sDateiKundenListe, ReadOnly:=True)
With wbKundenListe.Worksheets(1)
Set Rng = .Columns(16).Find(what:="Test", LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False, After:=Range("P1"))
If Not Rng Is Nothing Then
firstaddress = Rng.Address
Do While Not Rng Is Nothing
If Rng.Offset(, 1).Value = "yes" Then
CustomerName = .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 18))
CustomerListBox.AddItem CustomerName(1, 1)
For i = 1 To CustomerListBox.ColumnCount - 1
CustomerListBox.List(CustomerListBox.ListCount - 1, i) = CustomerName(1, i + 1)
Next
Exit Do
Else
Set Rng = .Columns(16).FindNext(Rng)
If Rng.Address = firstaddress Then
Set Rng = Nothing
Exit Do
End If
End If
Loop
End If
If Rng Is Nothing Then
MsgBox "not found"
Else
wbKundenListe.Close SAVECHANGES:=False
Application.ScreenUpdating = True
Application.StatusBar = False
ClearUserformTxtbx2
End If
End With
End Sub

p45cal
10-30-2013, 02:38 PM
try:
Dim sDateiKundenListe As String, wbKundenListe As Workbook
Dim Rng As Range, strFirst As String
Dim i As Integer
CustomerListBox.Clear
sDateiKundenListe = "D:\Documents\ndalj25\Desktop\DataBase\CustomerDB.xlsx"
If CategoryComboBox.Value = "Test" Then
Application.ScreenUpdating = False
Application.StatusBar = "Loading Customer Address"
Set wbKundenListe = Application.Workbooks.Open(Filename:=sDateiKundenListe, ReadOnly:=True)
With wbKundenListe.Worksheets(1)
Set Rng = .Columns(16).Find(what:="Test", LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False, After:=Range("P1"))
If Not Rng Is Nothing Then
strFirst = Rng.Address
Do
If Application.Trim(UCase(Rng.Offset(, 1).Value)) = "YES" Then
CustomerName = .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 18))
CustomerListBox.AddItem CustomerName(1, 1)
For i = 1 To CustomerListBox.ColumnCount - 1
CustomerListBox.List(CustomerListBox.ListCount - 1, i) = CustomerName(1, i + 1)
Next
End If
Set Rng = .Columns(16).FindNext(Rng)
Loop While Not Rng Is Nothing And strFirst <> Rng.Address
End If
End With
wbKundenListe.Close SAVECHANGES:=False
Application.ScreenUpdating = True
Application.StatusBar = False
End If
End Sub

Aranell
10-31-2013, 01:50 AM
Thhhhhhhhhhhhhhhhhhhhhhhhhhhhhhaaaannnnnnnnnnnnnnnk youuuuuuuuuuuuuuu :thumb :biggrin: