I'm using code below, for check another textbox value when exiting initial textbox and if it null, making initial one null and set focus on final textbox.
But i give this error: Run-time error'-2147467259(80004005)': Unspecific error.
when i made comment this line (txtTimeUnit = vbNullString), macro code works correctly.
whats the problem of that line's command and please help me correcting code.
Private Sub txtTimeUnit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If txtStartDate.Text = vbNullString Then
txtTimeUnit = vbNullString
txtStartDate.SetFocus
Exit Sub
End If
End Sub
Like I said your code works. Here is an example
Private Sub txtTimeUnit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If txtStartDate.Text = vbNullString Then
txtTimeUnit.Text = vbNullString
txtStartDate.SetFocus
Exit Sub
End If
End Sub
The only way it will not work is when there is another piece of code which is setting the Cancel = True. For example
Private Sub txtTimeUnit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsError(Application.Match(txtTimeUnit.Text, Range("intTable[Time Unit]"), 0)) Then
Cancel = True
End If
If txtStartDate.Text = vbNullString Then
txtTimeUnit.Text = vbNullString
txtStartDate.SetFocus
Exit Sub
End If
End Sub
To prevent such kind of errors you can use a Boolean Variable
Dim boolOnce As Boolean
Private Sub txtTimeUnit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If boolOnce = False Then
boolOnce = True
If IsError(Application.Match(txtTimeUnit.Text, Range("intTable[Time Unit]"), 0)) Then
Cancel = True
End If
Else
boolOnce = False
End If
If txtStartDate.Text = vbNullString Then
txtTimeUnit.Text = vbNullString
txtStartDate.SetFocus
Exit Sub
End If
End Sub
Related
I have a userform. The idea is to check if there are any 'True' values in column(15) in 'Admin' sheet. If there is at least a single 'True' value, then the userform will remain open and continue its operation.
However, if there is not a single 'True' found, then the userform will display a message and close the userform automatically.
Private Sub Userform_initialize()
Dim LR As Long
LR = Sheets("Project_Name").Cells(Rows.Count, "B").End(xlUp).Row
With Worksheets("Admin")
For i = 7 To LR
If .Cells(i, 15) = "True" Then
Exit For
Else
MsgBox ("No values found")
Exit For
Unload Me
End If
Next i
End With
''' more code'''
End Sub
Everything on my userform works as expected, except for the fact I am unable to make it close itself automatically. I.e. Unload Me is not working.
Any advice?
You should check your criteria before you even display the UserForm. You can add this as a condition wherever you are calling the UserForm. No need to open the form just to immediately close it when you can check before-hand.
On the first instance of True, the UserForm will open, and exit the sub. If the loop completes (finds no True values), the sub will proceed to your MsgBox
Sub OpenForm
With Worksheets("Admin")
For i = 7 To LR
If Cells(i,15) = "True" then
Userform.Show
Exit Sub
End If
Next i
End With
MsgBox "No Values Found"
End Sub
Please look at your code; you have put Unload Me is after Exit For
'Here is something for you to ponder on .........
'Public enum type to add a set of particular vbKeys to the standard key set
Public Enum typePressKeys
vbNoKey = 0
vbExitTrigger = -1
vbAnswerKey = 100
vbLaunchKey = 102
vbPrevious = 104
vbNext = 106
vbSpecialAccessKey = 108
End Enum
Public Sub doSomethingWithMyUserform()
Dim stopLoop As Boolean, testVal As Boolean, rngX As Range, LR As Long
LR = ThisWorkbook.Sheets("Project_Name").Cells(Rows.Count, "B").End(xlUp).Row
Set rngX = ThisWorkbook.Worksheets("Admin")
testVal = False
With rngX 'Your sub can do the check here
For i = 7 To LR
If .Cells(i, 15) = "True" Then
testVal = True
Exit For
End If
Next i
End With
If testVal Then
Load UserForm1
With UserForm1
.Caption = "Something"
.Tag = vbNoKey
.button_OK.SetFocus 'Assuming you have a OK button on Userform1
End With
UserForm1.Show
stopLoop = False
Do
If UserForm1.Tag = vbCancel Then
'Do something perhaps
Unload UserForm1
stopLoop = True
ElseIf UserForm1.Tag = vbOK Then
'Do something specific
Unload UserForm1
stopLoop = True
Else
stopLoop = False
End If
Loop Until stopLoop = True
else
MsgBox "No values found"
End If
'Here you can close the way you want
Set rngX = Nothing
End Sub
enter code here
In below program, I receive this error: Run-time error '-2147467259(80004005)': Unspecified error. by highlight this code: txtStartDate.SetFocus in this line: If txtStartDate.Text = "" Then txtStartDate.SetFocus
Private Sub txtTimeUnit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsError(Application.Match(txtTimeUnit.Text, Range("intTable[Units]"), 0)) Then
lblStatusBar = "Please correct value."
Cancel = True
Exit Sub
End If
lblStatusBar = vbNullString
Range("CToDate").Value = txtTimeUnit.Text
If txtStartDate.Text = "" Then txtStartDate.SetFocus
If txtEndDate.Text = "" Then txtEndDate.SetFocus
End Sub
Can anyone help me about this error and passing text box focus (Cursor) to another text box?
Replace
If txtStartDate.Text = "" Then txtStartDate.SetFocus
by
If txtStartDate.Text = "" Then
txtStartDate.SetFocus
Exit Sub
End If
I have the below code that will throw a prompt when a particular sheet is empty before saving the workbook.
Purpose of code: To check, if value of drop-down is "yes" in Main Sheet and if "yes", check if given range on a particular sheet is blank. If "yes", throw a prompt and change the drop down value to "No" on main sheet.
Concern: For loop in the code will check if any cell is empty in given range, instead, I want a code to check if there is an entry in any one cell in given range. Lets say given range is E10:G19, if we have an entry in E10, It should come out of the code and should not throw a prompt and should throw only if all the cells in given range is empty.
Question: What should replace my For loop that can serve my purpose?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Dim Rvalue As Range
Dim cell As Range
Set Rvalue = Sheets("Uni-corp").Range("E10:G19")
If Worksheets("Main").Range("E29").Value = "YES" Then
For Each cell In Rvalue
If IsEmpty(cell) Then
bOk = True
Exit For
Else: bOk = False
End If
Next
If bOk Then
If MsgBox("Sheet is blank", vbOKCancel + vbInformation) = vbOK Then
Worksheets("Main").Range("E29").Value = "NO"
Cancel = True
End If
End If
End If
End Sub
Here you go:
Option Explicit
Public Function b_is_range_empty(my_rng As Range)
If Application.WorksheetFunction.CountA(my_rng) > 0 Then
b_is_range_empty = False
Else
b_is_range_empty = True
End If
End Function
Public Sub TestMe()
Debug.Print b_is_range_empty(Selection)
End Sub
The idea is to use the built-in formula in Excel - CountA. It is optimized for faster search. In the test it works with selection of the area.
Edit:
In stead of this:
For Each cell In Rvalue
If IsEmpty(cell) Then
bOk = True
Exit For
Else: bOk = False
End If
Next
Write simply this:
bOK = b_is_range_empty(Rvalue)
Maybe you're after something like this:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If UCase(Worksheets("Main").Range("E29").Value) <> "YES" Then Exit Sub
If WorksheetFunction.CountA(Worksheets("Uni-corp").Range("E10:G19")) > 0 Then Exit Sub
If MsgBox("Sheet is blank", vbOKCancel + vbInformation) = vbOK Then
Worksheets("Main").Range("E29").Value = "NO"
Cancel = True '<--| this will make the macro not save the workbook
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Dim Rvalue As Range
Dim cell As Range
Set Rvalue = Sheets("Uni-corp").Range("E10:G19")
If Worksheets("Main").Range("E29").Value = "YES" Then
For Each cell In Rvalue
If IsEmpty(cell)<>true Then
bOk = false
Exit For
Else: bOk = true
End If
Next
If bOk Then
If MsgBox("Sheet is blank", vbOKCancel + vbInformation) = vbOK Then
Worksheets("Main").Range("E29").Value = "NO"
Cancel = True
End If
End If
If bOk=false Then
If MsgBox("Sheet is not blank", vbOKCancel + vbInformation) = vbOK Then
Worksheets("Main").Range("E29").Value = "Yes"
Cancel = True
End If
End If
End If
End Sub
You appear to be exiting your for loop when the first cell is empty, you will want it to only exit when it finds a value instead:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Dim Rvalue As Range
Dim cell As Range
Set Rvalue = Sheets("Uni-corp").Range("E10:G19")
If Worksheets("Main").Range("E29").Value = "YES" Then
For Each cell In Rvalue
If IsEmpty(cell) Then
bOk = True
'Exit For moved to Else section
Else: bOk = False
Exit for
End If
Next
If bOk Then
If MsgBox("Sheet is blank", vbOKCancel + vbInformation) = vbOK Then
Worksheets("Main").Range("E29").Value = "NO"
Cancel = True
End If
End If
End If
End Sub
#
updated codes
Function condition(ByRef objCmb As ComboBox)
If objCmb.Value ="" And objCmb.Value = "g" Then
Call MsgBox("gg", vbOKOnly, "error")
End If
End Function
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition (ComboBox1)
End Sub
'other codes for reference:
Private Sub CommandButton1_Click()
Dim lastrow As Integer
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To 3
For j = 1 To 5
With Me.Controls("ComboBox" & (i - 1) * 5 + j)
If .Text <> "" Then
Cells(lastrow + i, j) = .Text
Else
Exit Sub
End If
End With
Next j
Next i
End Sub
I have 50 combo and text boxes in VBA user panel. As it is too troublesome to set constraints in every combo or text box, I want a function to apply to every combo and text box.
For the codes above , it shows up cant find objecterror
How to solve ?
Btw , how to set the function statement for textbox ?
is it Function condition2(ByRef objCmb As textbox)...
You are receiving an error because ComboBox is not ByRef objCmb As ComboBox. Don't use parenthesis when calling a sub. Don't use parenthesis when calling function if you are not using the functions return value. If a function does not return a value it should be a sub.
Sub condition(ByRef objCmb As MSForms.ComboBox)
If objCmb.Value <> "" And objCmb.Value = "g" Then
MsgBox "gg", vbOKOnly, "error"
objCmb.Value = ""
End If
End Sub
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
I wrote a function to help you generate the Exit event code for all your text and combo boxes.
Sub AddCodeToCipBoard(frm As UserForm)
Const BaseCode = " Private Sub #Ctrl_Exit(ByVal Cancel As MSForms.ReturnBoolean)" & vbCrLf & _
" condition ComboBox1" & vbCrLf & _
" End Sub" & vbCrLf & vbCrLf
Dim s As String
Dim ctrl
Dim clip As DataObject
Set clip = New DataObject
For Each ctrl In frm.Controls
If TypeName(ctrl) = "ComboBox" Or TypeName(ctrl) = "TextBox" Then
s = s & Replace(BaseCode, "#Ctrl", ctrl.Name)
End If
Next
clip.SetText s
clip.PutInClipboard
End Sub
Put this code in a module and call it like this:
AddCodeToCipBoard Userform1
Now all the Exit event code will be copied into the Windows Clipboard. Go into your Userforms code module and paste the new code.
Example Output:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
I am currently making an userform in which I got multiple textboxes. So for now I got a total of 15 textboxes and each of them should only contain numerical values. The code I got now for each TextBox is:
Private Sub TextBox1_Change()
If TypeName(Me.ActiveControl) = "TextBox" Then
With Me.ActiveControl
If Not IsNumeric(.Value) And .Value <> vbNullString Then
MsgBox "Sorry, only numbers allowed"
.Value = vbNullString
End If
End With
End If
End Sub
Private Sub TextBox2_Change()
If TypeName(Me.ActiveControl) = "TextBox" Then
With Me.ActiveControl
If Not IsNumeric(.Value) And .Value <> vbNullString Then
MsgBox "Sorry, only numbers allowed"
.Value = vbNullString
End If
End With
End If
End Sub
.
.
.
Private Sub TextBox15_Change()
If TypeName(Me.ActiveControl) = "TextBox" Then
With Me.ActiveControl
If Not IsNumeric(.Value) And .Value <> vbNullString Then
MsgBox "Sorry, only numbers allowed"
.Value = vbNullString
End If
End With
End If
End Sub
The way I am doing it now feels kind of sloppy since I am copying the same code for each textbox. My question is therefor whether it is possible to consolidate these routines so that I will only require one code for all off the TextBoxes?
Kind regards and thanks in advance,
Maurice
Simple example:
Add a new class module to your project and rename it NumericTextbox. Paste this code into it:
Option Explicit
Private WithEvents tb As MSForms.TextBox
Public Property Set TextControl(t As MSForms.TextBox)
Set tb = t
End Property
Private Sub tb_Change()
With tb
If Not IsNumeric(.Value) And .Value <> vbNullString Then
MsgBox "Sorry, only numbers allowed"
.Value = vbNullString
End If
End With
End Sub
Now in your userform, add this code:
Option Explicit
Private colTBs As Collection
Private Sub UserForm_Initialize()
Dim ctl As MSForms.Control
Dim oHandler As NumericTextbox
Set colTBs = New Collection
For Each ctl In Me.Controls
If TypeOf ctl Is MSForms.TextBox Then
Set oHandler = New NumericTextbox
Set oHandler.TextControl = ctl
colTBs.Add oHandler
End If
Next ctl
End Sub
and there you go.
I just passed the textbox as an argument into my function as follows:
sheet code
Private Sub TextBox1_Change()
test Me.TextBox1
End Sub
Private Sub TextBox2_Change()
test Me.TextBox2
End Sub
Module code:
Sub test(textbox As Object)
With textbox
If Not IsNumeric(.Value) And .Value <> vbNullString Then
MsgBox "Sorry, only numbers allowed"
.Value = vbNullString
End If
End With
End Sub
The easy way would be to have a handler for each of the text boxes so that a particular procedure follows each individual action, I would suggest separating your procedure as the following
Private Sub checkValue()
With Me.ActiveControl
If Not IsNumeric(.Value) And .Value <> vbNullString Then
MsgBox "Sorry, only numbers allowed"
.Value = vbNullString
End If
End With
End Sub
`Then call that sub from each of the textbox_change() procedures