VBA to launch userform by selecting a cell

tynawg

New Member
Joined
Oct 11, 2019
Messages
42
Hello,

I have data sets I want to have code for that if I select a specific column, cell it opens a userform.

The data set starts with a number such as 9334231/1 below. It will always vary in length. then another number, just different, indicates start of a new data set.

If I was to select an Item code, Qty/Hrs etc I want that action to open a userform. I dont have a clue which way would be best?

The userform has been made in which I can select the trade in the first box, then codes associated with that trade populate the second box. On selection of a Item code the Qty/Hrs, Description and Location/Asset display in a textbox so the user can see if that is the code they want.

Essentially a data validation.

Often the client will send the order with incorrect Item code or Qty/Hrs and this is trying to automate changing the code.

9334231/1
191
TradeItem CodeQty/HrsDescriptionLocation/Asset
CABCARPCACU011Feature = N/A, Ease, rehang and adjust cupboard or meter box door, hinges and catch
Hinges to LHS door
Location: Bathroom
CABCARPCADB021Feature = DOOR, Replace or SAI satin chrome wall mounted door buffer stop
Bathroom 1: Door Buffer: Replace: Missing
Location: Bathroom
CABCARPCARL021Feature = N/A, Replace or SAI 1200 mm long x 19 mm diameter chrome towel rail
Bathroom 1: Towel Rail: Replace: Cracking
Location: Bathroom
CABCARPCARL051Feature = N/A, Replace or SAI toilet paper holder
Bathroom 1: Toilet Roll Holder: Replace: Rusted
Location: Bathroom
CABPAINPTRC021Feature = CEIL, Paint room complete(wet room up to 5 m2)Location: Bathroom
CABTILECAFJ018Feature = SHOW, Seal fixture joint or gap (minimum 2 m per site)
Bathroom 1: Shower: Replace: Fixture joint is mouldy - to also include fixture joint along bottom of screen outside the shower
Location: Bathroom
CABTILECATW010.25Feature = WALL, Replace or SAI 150 mm x 150 mm or 200 mm x 200 mm glazed wall tiles to wet area
for new bench top
Location: Bathroom
CABCARPCACU022Replace or SAI cupboard door catch or safety catchLocation: Bedroom
CABCARPCADB021Feature = RF, Replace or SAI satin chrome wall mounted door buffer stop
Bedroom 1: Right Front:Door Buffer: Replace: Missing
Location: Bedroom
CABCARP
CADH042Feature = RF, Replace or SAI dummy trim door knob door
Bedroom 1: Right Front:Built in Robes: Replace: Dummy sets missing
Location: Bedroom






<colgroup><col style="mso-width-source:userset;mso-width-alt:2998; width:62pt" width="82" span="2"> <col style="mso-width-source:userset;mso-width-alt:2230;width:46pt" width="61"> <col style="mso-width-source:userset;mso-width-alt:14262;width:293pt" width="390"> <col style="mso-width-source:userset;mso-width-alt:6070;width:125pt" width="166"> </colgroup><tbody>
</tbody>

<colgroup><col style="mso-width-source:userset;mso-width-alt:2998; width:62pt" width="82" span="2"> <col style="mso-width-source:userset;mso-width-alt:2230;width:46pt" width="61"> <col style="mso-width-source:userset;mso-width-alt:14262;width:293pt" width="390"> <col style="mso-width-source:userset;mso-width-alt:6070;width:125pt" width="166"> </colgroup><tbody>
Code:
Private Sub UserForm_Initialize()
    
    Me.ComboBox1.RowSource = ""
    Me.ComboBox2.RowSource = ""
    Me.TextBox1.MultiLine = True
    Me.TextBox1.BackColor = "&H80000004"
    
    'This code pulls the trade names
    With Sheets("GMSORs")
    Me.ComboBox1.List = .Range("K2", .Cells(.Rows.Count, "K").End(xlUp)).Value
    End With

End Sub


Private Sub ComboBox2_Enter()
Dim vList, i As Long

With Sheets("GMSORs")
vList = .Range("A1:B" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With

Me.ComboBox2.Clear
    
    For i = LBound(vList) To UBound(vList)
    If UCase(vList(i, 1)) = UCase(Me.ComboBox1.Value) Then Me.ComboBox2.AddItem vList(i, 2)
    Next

End Sub


Private Sub ComboBox1_Change()
Me.ComboBox2.Clear
End Sub


Private Sub ComboBox2_Change()
Dim c As Range
Dim fm

TextBox1 = ""
With Sheets("GMSORs")
fm = Application.Match(Me.ComboBox2, .Range("B1", .Cells(.Rows.Count, "B").End(xlUp)), 0)
    If IsNumeric(fm) Then
        For Each c In .Range("C" & fm & ":E" & fm)
            tx = tx & " - " & c
        Next
        TextBox1 = Right(tx, Len(tx) - 3)
    End If
 
End With
End Sub

Private Sub TextBox1_Enter()
Me.ComboBox2.SetFocus
End Sub
</tbody>
 

Some videos you may like

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Watch MrExcel Video

Forum statistics

Threads
1,113,838
Messages
5,544,607
Members
410,626
Latest member
rkmadasu
Top