List Box Code needs Tidy Up

[edwards1979]

I am using the following code to link 2 listboxes - the case outcome here could eventually become any one of 50 cases, therefore I was looking for a way of tidying up the code :-

Private Sub ListBox1_Click()
'Get the currently selected item
Select Case ListBox1.Value
'If Project Documents, set RowSource property of ListBox2
'to Column B.
Case "Project Documents"
ListBox2.RowSource = "Datasheet!H4:H18"

Case "MSE Procedures"
ListBox2.RowSource = "Datasheet!H19:H52"

Case "Administration"
ListBox2.RowSource = "Datasheet!H53:H60"

Case "Trackers"
ListBox2.RowSource = "Datasheet!H61:H64"

Case "Internet / Doc. Search"
ListBox2.RowSource = "Datasheet!H61:H64"
End Select
End Sub

(I have entered the row source of listbox1 into properties to give these case headings!)

 

[Jonmo1]

Is there some other information in another column that could be used as a Key ?
Example, for H4:H18 Case is "Project Documents", is there any value in another column that would be unique to rows 4-18?

 

[edwards1979]

Not at present but there is no reason why there can't be.

 

[Jonmo1]

OK, I have an idea...

Add a key column so each section of rows has a unique value in that new column.
And make sure the data in that sheet is sorted. So ALL of each section are together, not spread out, and there are no blanks in the key column..Oh, and they KEY data in the key column should be the same as the name of item in listbox1

Project Documents = row 4:18
MSE Procedures = row 19:52
etc..

Is that doable?

 

[edwards1979]

Thats fine and easily doable...

 

[Jonmo1]

Try this

I've commented the best I could, you should figure out what to modify.
I've assumed the KEY range is column A on Sheet1, and the resulting rowsource for ListBox 2 is in column B of sheet 1

Hope it helps..

Private Sub ListBox1_Click()
Dim ws As Worksheet
Dim LR As Long, LB1FR As Long, LB1LR As Long
Dim LB2Rwsrc As Range
 
'Sheet Containing KEY List
Set ws = Sheets("Sheet1")
 
'Uses Column A for Key List
LR = ws.Cells(Rows.Count, "A").End(xlUp).Row
Set KeyRange = ws.Range("A1:A" & LR)
 
'Find First Row containing Key Item
On Error Resume Next
LB1FR = Application.Match(ListBox1.Value, KeyRange, 0)
On Error Goto 0
 
'Exit sub if Key Item Not Found
If LB1FR = 0 Then Exit Sub
 
'Count Occurances of Key Item
LB1LR = Application.CountIf(KeyRange, ListBox1.Value)
 
'Set RowSource Range for Listbox2 in Column B
Set LB2Rwsrc = ws.Range("B" & LB1FR).Resize(LB1LR)
 
'Apply RowSource Range to LIstbox 2
ListBox2.RowSource = "'" & ws.Name & "'!" & LB2Rwsrc.Address
End Sub