Problem using INDEX to select items in listbox

[Shazbot]

I have a worksheet (Data):

A B C
IMS Line
Accurate y
Banctec y y
Advisor y
Excel y

There are 12 rows. Column A is a list of services, IMS and LIne are
components used by those services. In this example Accurate uses IMS so
there is a y in cell B2.

I have a form with 2 listboxes, one (lbcomp) is autopopulated using
cells B1:C1. the other (lbsource) is autopopulated using cells A2:A12.
When a user selects a component from lbcomp I want all of the services
with a y against them to be highlighted, so if someone chooses IMS I
want Accurate, Banctec and Excel to be selected in lbsource.

So far I have written code which makes a msgbox report whethere the
service is used or not (i haven't quite figured out the selection part
yet). My code works for the first two rows but when it hits the third
time it fails and I get a Runtime error 13, type mismatch error. I am
new to VBA and tend to clone what I can from this group and others so
this has me stumped. The offending code follows:

Private Sub Lbcomp_Click()
Dim iloop As Integer
Dim res As String

For iloop = 0 To lbsource.ListCount - 1


res = Application.Index(Worksheets("Data").Range("b2:c12"), _
Application.Match(lbcomp.Text, _
Worksheets("Data").Range("b1:c1"), 0), _
Application.Match(lbsource.List(iloop), _
Worksheets("Data").Range("a2:a12"), 0))

If res = "y" Then
MsgBox lbsource.List(iloop) & " uses this component."

Else:
If res = "" Then
MsgBox lbsource.List(iloop) & " doesn 't use this component."

Else

If IsEmpty(res) Then
MsgBox "res is empty!"
End If
End If

End If

Next iloop
End Sub


Any help would be greatly appreciated!
Thanks very much

 

[Bernie Deitrick]

Sharon,

You have reversed the row and column indices in your index function:

res = Application.Index(Worksheets("Data").Range("b2:c12"), _
Application.Match(lbcomp.Text, _
Worksheets("Data").Range("b1:c1"), 0), _
Application.Match(lbsource.List(iloop), _
Worksheets("Data").Range("a2:a12"), 0))

should be

res = Application.Index(Worksheets("Data").Range("b2:c12"), _
Application.Match(lbsource.List(iloop), _
Worksheets("Data").Range("a2:a12"), 0), _
Application.Match(lbcomp.Text, _
Worksheets("Data").Range("b1:c1"), 0))

As for selecting (highlighting) the applicable items in lbsource, use code like

If LCase(res) = "y" Then
lbsource.Selected(iloop) = True
End If

Make sure you set the MultiSelect property of lbsource to

1 - fmMultiSelectMulti

and get rid of all your message boxes.

HTH,
Bernie
MS Excel MVP

 

[Dave Peterson]

This worked ok for me (as a userform, right????):

Option Explicit
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub ListBox1_Change()

Dim iCtr As Long
Dim WhichColumn As Long

If Me.ListBox1.ListIndex = -1 Then
'nothing selected
Else
WhichColumn = Me.ListBox1.ListIndex + 1
With Me.ListBox2
For iCtr = 0 To .ListCount - 1
.Selected(iCtr) = CBool(LCase(.List(iCtr, WhichColumn)) = "y")
Next iCtr
End With
End If

End Sub
Private Sub UserForm_Initialize()

Dim myCell As Range
Dim myRng As Range
Dim wks As Worksheet

Set wks = Worksheets("Data")

Set myRng = wks.Range("B1:C1")
With Me.ListBox1
For Each myCell In myRng.Cells
.AddItem myCell.Value
Next myCell
.MultiSelect = fmMultiSelectSingle
End With

Set myRng = wks.Range("a2:C12")
With Me.ListBox2
.ColumnCount = 3
.ColumnWidths = "12;0;0"
.List = myRng.Value
.MultiSelect = fmMultiSelectMulti
End With
End Sub

 

[Shazbot]

Thank you some much both of you, I tried yours first Bernie (it was
first and also less effort for me!). It worked perfectly. I have no
doubt yours would have worked too Dave, I am in these groups often
enough to know what kind of success rate you have! Thanks again, you
have saved me another day of scratching my head! I can't believe I had
mixed up the rows/columns....no wonder it failed on the third attempt!
It seems so simple now you have pointed it out but I doubt I would have
ever twigged.