VBA Userform help

[OK21294]

Hello,

I have a Userform set up with two list boxes and 1 command button.

The first List box will display a list of Sectors in which you can choose multiple entries. The second list box will display Subsectors and the command button should take whatever have been chosen to the desired cells. I would like the selection from the first list box to be taken to cells in the column "Sectors" and the selection from the second list box to go to the cells in the column named "subsectors".

So far my code works however I would like to be able to input different entries for each row. At the moment the code I have written changes the entire column.

Can anyone help? Please see code below

---

[TABLE="width: 500"]
<tbody>[TR]
[TD]Private Sub UserForm_Initialize()


With ListBox1
.List = Range("Cover!B3:B8").Value 'Range of cells with the list of sectors
.MultiSelect = fmMultiSelectMulti
End With

With ListBox2
.List = Range("Cover!C3:C8").Value 'Range of cells with list of sub-sectors
.MultiSelect = fmMultiSelectMulti
End With

UserForm1.Caption = "Select Sectors"
CommandButton1.Caption = "Select"

End Sub




Private Sub CommandButton1_Click()


Sectors = ""
For x = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(x) Then
If Sectors = "" Then
Sectors = Me.ListBox1.List(x, 0)
Else
Sectors = Sectors & "," & Me.ListBox1.List(x, 0)
End If
End If
Next x


ThisWorkbook.Sheets("Europe_Sector_Overview").Range("Sector") = Sectors


Subsectors = ""
For x = 0 To Me.ListBox2.ListCount - 1
If Me.ListBox2.Selected(x) Then
If Subsectors = "" Then
Subsectors = Me.ListBox2.List(x, 0)
Else
Subsectors = Subsectors & "," & Me.ListBox1.List(x, 0)
End If
End If
Next x


ThisWorkbook.Sheets("Europe_Sector_Overview").Range("Sub_Sector") = Subsectors


Me.Hide
End Sub


[/TD]
[/TR]
</tbody>[/TABLE]

---

 

[Worf]

Hello
I have a few questions:

• Does each sector has its own subsector list, or is there only one subsector list? How the sectors and subsectors relate?
• What are the addresses of the ranges named sector and subsector? I want to know if they are single cells.
• Where are the sectors and subsectors columns? I do not think they are columns B and C. To what worksheet(s) do you want to write?
• Are you going to perform multiple selections on both list boxes?
• Please give a before-after example: what were the selected items and what is the expected result.

 

[OK21294]

Hi Worf, thanks for replying.

Does each sector has its own subsector list, or is there only one subsector list? How the sectors and subsectors relate?
Each Sector has its own subsector list (however because I can't get it to work I combined all the subsector lists for ease) The Sectors are different types of infrastructure assets e.g. Energy related assets, Renewable Infrastructure assets, Communication assetsand the the Subsectors are different types within the sector list. E.g. for Renewable infrastructure this would include Wind Farms, Solar Farms and for Communications this would include Mobile, Fibre networks etc.
What are the addresses of the ranges named sector and subsector? I want to know if they are single cells.
There are two ranges each called sector and subsector. The first is in a sheet called "Cover", which lists the different Sectors (B3:B8) and Subsectors(C3:C8). The second is in the sheet Europe _ Sector _ Overview, which is where I would like the data (from the lists in the Cover sheet) to be entered. The aim is to be able to go into the Europe Sector Overview sheet and fill in what sectors and subsectors a particular investment funds invests in, hence I need to be able to select multiple sectors. In Europe_Sector_Overview, the named ranges Sector and Sub_sector refer to names ranges which are columns N and O and span from rows 3:155, however as the database is built there will be extra rows added which is why I have used a named range.
Where are the sectors and subsectors columns? I do not think they are columns B and C. To what worksheet(s) do you want to write?
Answered above
Are you going to perform multiple selections on both list boxes?
Yes!
Please give a before-after example: what were the selected items and what is the expected result.
i need to be able to select multiple Sectors in sheet Europe Sector Overview form the userform and then select multiple subsectors from the Userform (with the lists populated from the Cover sheet lists) and then once selected I will need the selected Sectors to go into column N and the selected Sub Sectors to go into Column O.
I have also tried doing two separate Userforms which might be easier- what do you think?
****** id="cke_pastebin" style="position: absolute; top: 0px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">Does each sector has its own subsector list, or is there only one subsector list? How the sectors and subsectors relate?
What are the addresses of the ranges named sector and subsector? I want to know if they are single cells.
Where are the sectors and subsectors columns? I do not think they are columns B and C. To what worksheet(s) do you want to write?
Are you going to perform multiple selections on both list boxes?
Please give a before-after example: what were the selected items and what is the expected result.
</body>

 

[Worf]

• We could have a table like the one below, and only the relevant subsectors would appear on the second list box, after the selections made on the first one. What do you think?
• Only one user form is necessary, it can have multiple pages if needed.

 

[OK21294]

Yes that is exactly what I need to do!

 

[Worf]

Hi

o Command button 1 writes the selected items on both list boxes to the worksheet.
o Command button 2 resets selections on both list boxes.
o Command button 3 populates list box 2 based on the selected items on list box 1.

Would you like a button to clear the contents of list box 2? This is flexible and can be tweaked.

' user form module
Dim ws As Worksheet
Private Sub CommandButton3_Click()  ' populate list box 2
Dim i%, r As Range, j%
For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) Then
        Set r = ws.Range("2:2").Find(Me.ListBox1.List(i, 0), , xlValues, xlWhole)
        For j = 3 To ws.Cells(Rows.Count, r.Column).End(xlUp).Row
            Me.ListBox2.AddItem ws.Cells(j, r.Column)
        Next
    End If
Next
End Sub
    
Private Sub CommandButton2_Click() ' reset selections on both list boxes
Me.ListBox1.MultiSelect = fmMultiSelectSingle
Me.ListBox1.Value = ""
Me.ListBox1.MultiSelect = fmMultiSelectMulti
Me.ListBox2.MultiSelect = fmMultiSelectSingle
Me.ListBox2.Value = ""
Me.ListBox2.MultiSelect = fmMultiSelectMulti
End Sub
    
Private Sub UserForm_Initialize()
Set ws = Sheets("cover")
With ListBox1
    .List = Range("Cover!a3:a" & ws.Range("a" & Rows.Count).End(xlUp).Row).Value ' sectors
    .MultiSelect = fmMultiSelectMulti
End With
Me.ListBox2.MultiSelect = fmMultiSelectMulti
UserForm1.Caption = "Select Sectors"
CommandButton1.Caption = "Transfer to Sheet"
End Sub


Private Sub CommandButton1_Click()  ' write to sheet
Dim last%, rng As Range, c%, i%
Set rng = Sheets("cover").Range("n:o")
last = rng.Find(What:="*", After:=rng.Cells(1), LookAt:=xlPart, LookIn:=xlFormulas, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row + 1
c = last
ws.Cells(last, "N") = "***"
ws.Cells(last, "O") = "***"
For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) Then
        c = c + 1
        ws.Cells(c, "N") = Me.ListBox1.List(i, 0)
    End If
Next
c = last
For i = 0 To Me.ListBox2.ListCount - 1
    If Me.ListBox2.Selected(i) Then
        c = c + 1
        ws.Cells(c, "O") = Me.ListBox2.List(i, 0)
    End If
Next
End Sub