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>
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Userform code

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
 
Upvote 0
.
To assist you better (and quicker) ... if you could post a copy of your workbook to a cloud site (www.dropbox.com or similar) then post a link for download
so volunteers can see what you are dealing with.

It is difficult at best to re-create everything you see there.
 
Upvote 0
.
In the Sheet module paste this :

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


If ActiveCell.Column <> 2 Then Exit Sub
    shwfrm


End Sub


Create a Regular module and paste this :

Code:
Option Explicit


Sub shwfrm()
    GMSORs.Show
End Sub





In the Userform Initialize macro change it to this :

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("GM SOR's")
        Me.ComboBox1.Value = ActiveCell.Offset(0, -1).Value
        Me.ComboBox2.Value = ActiveCell.Value
        ActiveCell.Offset(0, 1).Select
    End With


End Sub


Understand that with these changes in code, you are eliminating the way the Userform performed previously. You can no longer only open the UserForm and make a selection
from the two drop downs. The two drop downs are now solely populated by the cell (Col B only) the user double-clicks.
 
Upvote 0
Hi Logit,

Thanks, however the userform references a large range of data to select from. The idea was that if a user selected a cell in column B say, the userform opens and a different selection can be made to a different Item code.
If I understand correctly this capability is lost with your suggestion?
Regards,
Wayne
 
Upvote 0
.
Use this macro for the UserForm Initialize event :

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("GMSOR's")
    Me.ComboBox1.List = .Range("K2", .Cells(.Rows.Count, "K").End(xlUp)).Value
    ActiveCell.Offset(0, 1).Select
    End With


End Sub
 
Upvote 0
"launch userform by selecting a cell" and maintain the original design allowing for selecting from the entire list instead of the cell selection that was clicked.
 
Upvote 0

Forum statistics

Threads
1,213,490
Messages
6,113,957
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top