I'm trying to configure Userform research with 3 textboxes, but I can't make it work and don't know why.
This is my code:
Private Sub TextBox1_AfterUpdate()
On Error GoTo 1
If WorksheetFunction.CountIf(Sheets("Feuil1").Range("A:A"), Me.TextBox1.Value) = 0 Then
MsgBox "introuvable"
End If
With Me
.TextBox2 = Application.WorksheetFunction.VLookup(CLng(Me.TextBox1), Feuil1.Range("A:E"), 2, 0)
End With
1
End Sub
hoping for your help
thanks
Drop the WorksheetFunction and then there will be no run-time error if there's no match:
Private Sub TextBox1_AfterUpdate()
Dim r
r = Application.VLookup(CLng(Me.TextBox1), Feuil1.Range("A:E"), 2, False)
Me.TextBox2 = IIf(IsError(r),"Introuvable", r)
End Sub
Related
I have a data in column B which is dynamic ( cities can be in any order) , what I am looking is for a VBA code to fill color in the rectangle shape ( I have renamed rectangle shapes to corresponding city names). based on the color of corresponding city.
This is sample list, and actual data can be long, Hence was looking for an automated script to do this task.
Please, try the next approach. It will use a class, able to trigger the interior color change:
Insert a class module, name it "clsCelColorCh", copy and place the next code:
Option Explicit
Private WithEvents cmBar As Office.CommandBars
Private cellsCountOK As Boolean, arrCurColor(), arrPrevColor(), sCellAddrss() As String
Private sVisbRngAddr As String, i As Long, objSh As Worksheet, cel As Range, rngBB As Range
Public Sub ToSheet(sh As Worksheet)
Set objSh = sh
End Sub
Public Sub StartWatching()
Set cmBar = Application.CommandBars
End Sub
Private Sub Class_Initialize()
cellsCountOK = False
End Sub
Private Sub cmBar_OnUpdate()
If Not ActiveSheet Is objSh Then Exit Sub
Set rngBB = Intersect(ActiveWindow.VisibleRange, objSh.Range("B:B"))
If rngBB Is Nothing Then Exit Sub
If sVisbRngAddr <> rngBB.Address And sVisbRngAddr <> "" Then
Erase sCellAddrss: Erase arrCurColor: Erase arrPrevColor
sVisbRngAddr = "": cellsCountOK = False
End If
i = -1
On Error Resume Next
For Each cel In rngBB.cells
ReDim Preserve sCellAddrss(i + 1)
ReDim Preserve arrCurColor(i + 1)
sCellAddrss(i + 1) = cel.Address
arrCurColor(i + 1) = cel.Interior.Color
If arrPrevColor(i + 1) <> arrCurColor(i + 1) Then
If cellsCountOK = True Then 'call the pseudo event Sub
CallByName objSh, "Cell_ColorChange", VbMethod, cel
arrPrevColor(i + 1) = arrCurColor(i + 1)
End If
End If
i = i + 1
If i + 1 >= rngBB.cells.count Then
cellsCountOK = True
ReDim Preserve arrPrevColor(UBound(arrCurColor))
arrPrevColor = arrCurColor
End If
arrPrevColor(i + 1) = arrCurColor(i + 1)
Next
On Error GoTo 0
sVisbRngAddr = rngBB.Address
End Sub
Copy the next code in the sheet to monitor color changes code module (right click on the sheet name and choose View Code):
Option Explicit
Private ColorChEventMonitor As clsCelColorCh
Public Sub Cell_ColorChange(Target As Range)
Dim sh As Shape
On Error Resume Next
Set sh = Me.Shapes(Target.Value)
On Error GoTo 0
If Not sh Is Nothing Then
sh.Fill.ForeColor.RGB = Target.Interior.Color
Else
MsgBox "No shape named as """ & Target.Value & """ in this sheet..."
End If
End Sub
Private Sub Worksheet_Activate()
StartEventWatching
End Sub
Private Sub Worksheet_Deactivate()
StopEventWatching
End Sub
Private Sub StartEventWatching()
Set ColorChEventMonitor = New clsCelColorCh
ColorChEventMonitor.ToSheet Me
ColorChEventMonitor.StartWatching
End Sub
Private Sub StopEventWatching()
Set ColorChEventMonitor = Nothing
End Sub
Deactivate the sheet in discussion (go on a different sheet) and go back. I this way, the sheet Activate event starts the color change monitoring.
It does it for color changes in column "B:B".
In order to see it working, of course, there must be so many shapes as records in column "B:B", named exactly like the cells value. Anyhow, if a cell value does not match any shape, no error will be raised, a message mentioning that a correspondent shape does not exist will appear.
The pseudo event is triggered when you select another cell. Sometimes, it is triggered only by simple changing the color, but not always...
Please, test it and send some feedback.
I tested the following code in Excel 2016. But I encounter an
error message of 1004
and the code does not work.
Error line:
Me.TextBox1.Text = Application.WorksheetFunction.VLookup(Me.ComboBox1.Value, xRg, 2, False))
Private Sub UserForm_Click()
Dim xRg As Range
Private Sub UserForm_Initialize()
Set xRg = Worksheets("Sheet1").Range("A2:B8")
Me.ComboBox1.List = xRg.Columns(1).Value
End Sub
Private Sub ComboBox1_Change()
Me.TextBox1.Text = Application.WorksheetFunction.VLookup(Me.ComboBox1.Value,
xRg, 2, False)
End Sub
It seems that xRg is declared outside of the scope of the ComboBox1_Change event. Thus, the Combobox1_Change() does not access it. Try to declare it within:
Private Sub ComboBox1_Change()
Dim xRg As Range
Set xRg = Worksheets("Sheet1").Range("A2:B8")
Me.TextBox1.Text = Application.WorksheetFunction.VLookup(Me.ComboBox1.Value, _
xRg, 2, False)
End Sub
As mentioned by #Vityata here, you will need to assign the xRg variable within your current code block as it has no reference to it.
As an addition to that though, I would advise ditching the vlookup application function in place of assignment by the combobox index: Me.ComboBox1.ListIndex and use that as the reference for the row in xRg:
Me.TextBox1.Value = xRg.Cells(Me.ComboBox1.ListIndex + 1, 2).Value
The ComboBox.ListIndex property is a 0 based array so I have added 1 on to get the proper row assignment.
I need some help with getting the right code to do the following:
I have 4 groups of radio buttons inside a frame in a userform
Each group is a simple Yes/No radio button
I have a textbox that I want to autofill with a score range of A-D depending on the # of "yes" radio buttons selected.
The "No" checkboxes really shouldn't do anything in regards to the textbox
Userform Name = TP_UF
Frame Name = fun_opt_frame
Option Button Name for "Yes" = fun_score_yes1-4
Textbox Name = fun_scorebox
Logic:
4 Yesses = A
3 Yesses = B
2 Yesses = C
1 Yes = D
It doesn't matter what order the yesses are selected, its a total count. I tried using code using the frame but not sure if that is the best way. The frame for these radio buttons isn't needed for any reason other then to perhaps make it easier to code. So I could throw out the frame if it's not necessary to get this working.
I am not sure where to start here. Any help would be appreciated.
pic
The quickest and easiest way for you to understand is - I guess - the following code. You have to put the code into the class module of the userform.
Option Explicit
Dim opt1 As Byte
Dim opt2 As Byte
Dim opt3 As Byte
Dim opt4 As Byte
Private Sub opt1Yes_Click()
opt1 = 1
EvalOpt
End Sub
Private Sub opt1No_Click()
opt1 = 0
EvalOpt
End Sub
Private Sub opt2yes_Click()
opt2 = 1
EvalOpt
End Sub
Private Sub opt2No_Click()
opt2 = 0
EvalOpt
End Sub
Private Sub opt3yes_Click()
opt3 = 1
EvalOpt
End Sub
Private Sub opt3No_Click()
opt3 = 0
EvalOpt
End Sub
Private Sub opt4yes_Click()
opt4 = 1
EvalOpt
End Sub
Private Sub opt4No_Click()
opt4 = 0
EvalOpt
End Sub
Private Sub EvalOpt()
Dim sumOpt As Byte
Dim res As String
sumOpt = opt1 + opt2 + opt3 + opt4
Select Case sumOpt
Case 1: res = "D"
Case 2: res = "C"
Case 3: res = "B"
Case 4: res = "A"
Case Else: res = ""
End Select
Me.fun_scorebox.text = res
End Sub
I assumed the option buttons are named opt1Yes, opt1No, opt2Yes, opt2No etc.
A more advanced solution would probably be to use classe modules and "collect" the option buttons in such a way.
I ended up going about this differently and I got it working using a counter. Thanks for the help! Posting code here in case anyone else needs it.
Option Explicit
Private Sub OptionButton1_Change()
set_counter
End Sub
Private Sub OptionButton2_Change()
set_counter
End Sub
Private Sub OptionButton3_Change()
set_counter
End Sub
Private Sub OptionButton4_Change()
set_counter
End Sub
Private Sub OptionButton5_Change()
set_counter
End Sub
Private Sub OptionButton6_Change()
set_counter
End Sub
Private Sub OptionButton7_Change()
set_counter
End Sub
Private Sub OptionButton8_Change()
set_counter
End Sub
Private Sub set_counter()
Dim x As Integer, counter As Integer
Me.TextBox1.Value = ""
counter = 0
For x = 1 To 8 Step 2
If Me.Controls("OptionButton" & x).Value = True Then counter = counter + 1
Next x
Me.TextBox1.Value = Choose(counter, "D", "C", "B", "A")
End Sub
Private Sub UserForm_Activate()
Me.TextBox1.Value = ""
End Sub
Private Sub UserForm_Click()
Dim x As Integer
Me.TextBox1.Value = ""
For x = 1 To 8
Me.Controls("OptionButton" & x).Value = False
Next x
End Sub
I’m trying to extract the employee name based on the employee id with a VLOOKUP formula in a User Form.
The code below inst working.
Private Sub CommandButton2_Click()
Label4.Caption = Sheet1.Application.WorksheetFunction.VLookup(TextBox1.Text, Range("A:B"), 2, False)
End Sub
The provlem here is when there is no match found. That's the cause of the error message. Here is the
the VBA code you should use:
Private Sub CommandButton2_Click()
On Error Resume Next
Label1.Caption = Sheet1.Application.WorksheetFunction.VLookup(TextBox1.Text, Range("A:B"), 2, False)
If Err.Number <> 0 Then
Err.Clear
Label1.Caption = "not found"
End If
End Sub
basically I have a userform which I would like to use to enter 2 data into another macro which I already have. The userform is as below:
Basically, I would like the OK button to be clicked and the data in the two boxes will be entered into another macro that I have. It would also be great if the OK button can help in a sense that it will prompt a warning if one of the boxes is not filled up.
So far, I do not have much of a code for this..
Private Sub UserForm_Click()
TextBox1.SetFocus
Sub Enterval()
End Sub
Private Sub TextBox1_Change()
Dim ID As String
ID = UserForm3.TextBox1.Value
End Sub
Private Sub TextBox2_Change()
Dim ID2 As String
ID2 = UserForm3.TextBox2.Value
End Sub
Private Sub OKay_Click()
Enterval
End Sub
Would appreciate any tips and help. Thanks!
My other macro
Private Sub CommandButton1_Click()
Dim Name As String
Dim Problem As Integer
Dim Source As Worksheet, Target As Worksheet
Dim ItsAMatch As Boolean
Dim i As Integer
Set Source = ThisWorkbook.Worksheets("Sheet1")
Set Target = ThisWorkbook.Worksheets("Sheet2")
Name = Source.Range("A3")
Problem = Source.Range("I13")
Do Until IsEmpty(Target.Cells(4 + i, 6)) ' This will loop down through non empty cells from row 5 of column 2
If Target.Cells(4 + i, 6) = Name Then
ItsAMatch = True
Target.Cells(4 + i, 7) = Problem ' This will overwrite your "Problem" value if the name was already in the column
Exit Do
End If
i = i + 1
Loop
' This will write new records if the name hasn't been already found
If ItsAMatch = False Then
Target.Cells(3, 6).End(xlDown).Offset(1, 0) = Name
Target.Cells(4, 6).End(xlDown).Offset(0, 1) = Problem
End If
Set Source = Nothing
Set Target = Nothing
End Sub
Thats the macro i have. As u said, i change the
othermacro
to CommandButton1_Click()
but it doesn't work
Quoting geoB except for one thing: when you .Show your UserForm from a main Sub, you can also .Hide it at the end and the macro that called it will continue its procedures.
Sub Okay_Click()
Dim sID1 As String, sID2 As String
' A little variation
If Me.TextBox1 = "" Or Me.TextBox2 = "" Then
MsgBox "Please fill all the input fields"
Exit Sub
End If
Me.Hide
End Sub
To address your TextBox, you can write in your main Sub UserForm3.TextBox1 for example
There is no need for an Enterval function. Instead, assume the user can read and follow instructions, then test whether that indeed is the case. Note that in your code ID and ID2 will never be used because they exist only within the scope of the subroutines in which they are declared and receive values.
To get started:
Sub Okay_Click()
Dim sID1 As String, sID2 As String
sID1 = UserForm3.TextBox1.Value
sID2 = UserForm3.TextBox2.Value
If Len(sID1 & vbNullString) = 0 Then
MsgBox "Box A is empty"
Exit Sub
End If
If Len(sID2 & vbNullString) = 0 Then
MsgBox "Box B is empty"
Exit Sub
End If
'Now do something with sID1, sID2
otherMacro(sID1, sID2)
End Sub
For your other macro, declare it like this:
Sub otherMacro(ID1, ID2)
...
End Sub
Also, the SetFocus method should occur in the form open event.