VBA to launch userform by selecting a cell

tynawg

New Member
Joined
Oct 11, 2019
Messages
38
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>
 

tynawg

New Member
Joined
Oct 11, 2019
Messages
38
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
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
2,909
.
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.
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
2,909
.
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.
 

tynawg

New Member
Joined
Oct 11, 2019
Messages
38
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
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
2,909
.
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
 

tynawg

New Member
Joined
Oct 11, 2019
Messages
38
Hello Logit,
I included the code but......what is it supposed to do?
Regards,
Wayne
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
2,909
"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.
 

Forum statistics

Threads
1,078,520
Messages
5,340,922
Members
399,399
Latest member
SravanaSandhya

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top