PDA

View Full Version : VBA form - Choose an item from 2 list boxes to select one row



jmcconnell
12-12-2020, 03:02 PM
I have a form on one spreadsheet but the form uses data from another spreadsheet.
The form has 2 listboxes - (OpenSites and OpenTurbines), a text box (Textbox1), a radio button (Closed) and has a button (Submit)

The listboxes are populated from a sheet called "RTS Tracker" using .additem. Sample of the spreadsheet is below:

https://www.mrexcel.com/board/attachments/1607438598321-png.27514/

The Opensites listbox is populated from Column 1 and duplicate entries are removed. Selecting an option from this listbox shows the corresponding numbers in OpenTurbines listbox. (eg, choosing Dyffryn Brodyn from 'OpenSites' would show 9, 6 & 10 in the second listbox 'Open Turbines'.

I'm struggling to achieve 2 things. I want to be able to make a selection from the 2 listboxes then add some text to Textbox1 so when I press 'Submit' the text is added to the corresponding row on the spreadsheet. The second thing is I want to be able to do is select the radio button and when I press submit, it would update the spreadsheet status to closed and then remove corresponding option from the 2nd listbox.

Here is my code so far - This only populates the list boxes and filters out duplicates in the first listbox.

Code to populate OpenSites listbox

Private Sub UserForm_activate()
Dim Lastrow As Long
Dim RTSWind As Workbook
Dim RTSTracker As Worksheet

Dim Test As New Collection
Dim rng As Variant, temp() As Variant
Dim Value As Variant, I As Single


Set RTSWind = Workbooks.Open("https://Path (https://path/) to the file/RTS testing.xlsm")
Set RTSTracker = RTSWind.Sheets("RTS Tracker")

'Identify range

rng = RTSTracker.Range("A3:A" & _
Sheets("RTS Tracker").Columns("A").Find("*", _
SearchOrder:=xlRows, SearchDirection:=xlPrevious, _
LookIn:=xlValues).Row)


'Filter unique values
On Error Resume Next
For Each Value In rng
If Len(Value) > 0 Then
Test.Add Value, CStr(Value)
End If
Next Value
On Error GoTo 0

ReDim temp(1 To Test.Count)
For I = 1 To Test.Count
temp(I) = Test(I)
Next I

'SelectionSort temp
For Each Value In temp
OpenSites.AddItem Value
Next Value

OpenSites.ListIndex = 0

Set Test = Nothing
End Sub

Code to populate OpenTurbines list (This is placed in the OpenSites Listbox sub)



Private Sub OpenSites_Click()Dim RTSWind As Workbook
Dim RTSTracker As Worksheet
Set RTSWind = Workbooks.Open("https://reshive.sharepoint.com/sites/ControlCentre/shared documents/5 core services/monitoring & escalation/control centre assistant/RTS testin
g.xlsm")
Set RTSTracker = RTSWind.Sheets("RTS Tracker")
lastrow = Cells(Rows.Count, "A").End(xlUp).Row


Me.OpenTurbines.Clear
curval = Me.OpenSites.Value
For x = 2 To lastrow
If RTSTracker.Cells(x, "a") = curval Then
Me.OpenTurbines.AddItem RTSTracker.Cells(x, "b")
End If
Next x
End Sub


Any help would be much appreciated
Thank you,
James