I have the following function in VBA:
Private Function Option1Checked(option1 As OptionButton) As Integer
option1.ForeColor = vbGreen
If (option1.Value = True) Then
Option1Checked = 1
End If
Option1Checked = 0
End Function
Whenever I try to call the function like this
counter = counter + Option1Checked(OptionButton1)
I get a type mismatch error at runtime. But OptionButton1 is OptionButton, so what am I doing wrong?
You're running into one of the 'features' of VBA here. If you refer to some objects, like the option button, without a property specified, VBA assumes you want the default property, not the object itself. In the case of the option button, the default property is .Value, so in your code, OptionButton1 is not the option button object, but rather TRUE or FALSE depending on whether or not the OptionButton1 is checked.
Your best bet will be to change your function to this:
Private Function Option1Checked(option1 As Boolean) As Integer
//option1.ForeColor = vbGreen
If (option1 = True) Then
Option1Checked = 1
Else
Option1Checked = 0
End If
End Function
The downside here is that you cannot change the foreground color of the option button to green without referring to it by name.
An alternative that would get you the functionality that you want would be to pass the name of the option button to your Function.
Private Function Option1Checked(ByVal option1 As String) As Integer
UserForm1.Controls(option1).ForeColor = vbGreen
If (UserForm1.Controls(option1) = True) Then
Option1Checked = 1
Else
Option1Checked = 0
End If
End Function
Sub MyCountingRoutine()
Dim str As String
str = OptionButton1.Name
counter = counter + Option1Checked(str)
End Sub
Make sure you include the Else in the If..Then statement in your function, otherwise you will always get 0 back.
Related
I created a userform with a large number of textboxes and tick boxes. When the userform is initialised, data is loaded into the textboxes and the tick box values are defined by values specified in one of the workbook tabs.
I have written code with lots of repetition. For example, I include the code below for every textbox that is populated by a number.
Controls("ll_f_m_prior").Value = Format(Range("ll_f_m_prior_p"), "standard")
If Controls("ll_f_m_prior").Value = "n/a" Or Controls("ll_f_m_prior").Value = "" Then
Controls("ll_f_m_prior").Enabled = False
cb1.Enabled = False
End If
I have 25+ textboxes where the code is repeated. I am looking for a way to call a function using two dynamic variables. In the above example, the two variables are ll_f_m_prior and cb1.
I tried this code
Sub error1(var1 As String, var2 As String)
Controls(var1).Value = Format(Range(var1), "standard")
If Controls(var1).Value = "n/a" Or Controls(var1).Value = "" Then
Controls(var1).Enabled = False
x = var2 & ".Enabled"
x = False
End If
End Sub
and calling the subroutine using the function:
Call error1("ll_f_m_prior_p", cb1)
When you call the sub with Call error1("ll_f_m_prior_p", cb1) cb1isn't a string.
Yet the sub expects a string.
So if you change the second variable to act as an object instead, that should make things easier.
Sub error1(var1 As String, var2 As Object)
Controls(var1).Value = Format(Range(var1), "standard")
If Controls(var1).Value = "n/a" Or Controls(var1).Value = "" Then
Controls(var1).Enabled = False
var2.Enabled = False
End If
End Sub
I have a workbook with userforms to write to several numeric and date fields. I need to validate the textbox control for proper numbers and dates.
Rather than replicate the validation for each textbox, I thought I would call a common subprocedure within the BeforeUpdae event of each textbox.
I have two problems.
If I execute the form and test using text in tbAmount box, it seems the ContolValidate procedure is not called.
If I run it in break mode with a breakpoint on Call ContolValidate(What, CurrentControl), it will step through that procedure.
Even though it steps through the procedure, the Cancel = True does not seem to work.
If I paste the ContolValidate code directly in the BeforeUpdate, the Cancel = True does work.
This code is all on the userform.
Private Sub tbAmount1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim What As String
Dim CurrentControl As Control
What = "NumericField"
Set CurrentControl = Me.ActiveControl
Call ContolValidate(What, CurrentControl)
End Sub
Private Sub ContolValidate(What, CurrentControl)
If Not IsNumeric(CurrentControl.Value) Then
ErrorLabel.Caption = "Please correct this entry to be numeric."
Cancel = True
CurrentControl.BackColor = rgbPink
CurrentControl.SelStart = 0
CurrentControl.SelLength = Len(CurrentControl.Value)
Else
If CurrentControl.Value < 0 Then
ErrorLabel.Caption = "This number cannot be negative."
Cancel = True
CurrentControl.BackColor = rgbPink
CurrentControl.SelStart = 0
CurrentControl.SelLength = Len(CurrentControl.Value)
End If
End If
End Sub
Private Sub tbAmount1_AfterUpdate()
ErrorLabel.Visible = False
tbAmount1.BackColor = Me.BackColor
End Sub
(1) When your control is named tbAmount1 and the code is in the code-behind module of the form, the trigger should fire.
(2) As #shahkalpesh mentioned in his comment, Cancel is not known in your validate-routine. Putting Option Explicit at the top of you code would show you that.
I would suggest to convert the routine to a function. In the code below, I return True if the content is okay and False if not (so you need to put a Not to the result to set the Cancel-parameter)
Private Sub tbAmount1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = Not ControlValidate("NumericField", Me.ActiveControl)
End Sub
Private Function ControlValidate(What, CurrentControl) As Boolean
ControlValidate = False
If Not IsNumeric(CurrentControl.Value) Then
errorlabel.Caption = "Please correct this entry to be numeric."
ElseIf CurrentControl.Value < 0 Then
errorlabel.Caption = "This number cannot be negative."
Else
ControlValidate = True ' Input is okay.
End If
If ControlValidate Then
CurrentControl.BackColor = vbWhite
Else
CurrentControl.BackColor = rgbPink
CurrentControl.SelStart = 0
CurrentControl.SelLength = Len(CurrentControl.Value)
End If
End Function
P.S.: I changed the name to ControlValidate - "contol" seems wrong to me...
I have built an Excel Macro (as an Excel Addin) to randomly generate numbers.
I built it because the rand() function on excel keep generating new numbers at each action in the Excel file. So I tried to build something that "freeze" the formula once it has generated a number.
It works pretty well but when I close the file and reopen it, the numbers change.
How can I fix that ?
I have tried something like : If current cell = Blank ==> generate, otherwise exit function. But it doesn't work.
Here is the code I'm using :
Function RandomFreeze()
Static AlreadyRandomized As Boolean
AlreadyRandomized = False
Static Low As Double
Static High As Double
Low = 1
High = 100000000
If Worksheets("Sheet1").Range("A1") = "" Then
If AlreadyRandomized = False Then
RandomFreeze = Int(Rnd * (High + 1 - Low)) + Low
AlreadyRandomized = True
End If
Else
MsgBox "Erreur"
AlreadyRandomized = True
End If
End Function
Any help with this issue will be appreciated.
Thanks in advance
You can store the value of AlreadyRandomized variable to a CustomDocumentProperty and read/set its value accordingly.
Public Sub T()
Dim p As Object
Set p = CustomPropertyByName("AlreadyRandomized")
If Not CBool(p.Value) Then 'Randomize
p.Value = True 'Randomized
End Sub
Two helper functions, one creates the property if it doesn't exist and returns a reference to it and the second simply checks if the property exists.
'CustomPropertyByName()
Public Function CustomPropertyByName(ByVal propertyName As String) As Object
If Not PropertyExists(propertyName) Then
ThisWorkbook.CustomDocumentProperties.Add Name:=propertyName, _
LinkToContent:=False, _
Type:=msoPropertyTypeNumber, _
Value:=0
End If
Set CustomPropertyByName = ThisWorkbook.CustomDocumentProperties(propertyName)
End Function
'PropertyExists()
Private Function PropertyExists(ByVal propertyName As String) As Boolean
Dim p As Object
For Each p In ThisWorkbook.CustomDocumentProperties
If p.Name = propertyName Then
PropertyExists = True
Exit Function
End If
Next p
End Function
Note: A runtime error occurs if you try to access a CustomDocumentProperty that doesn't exist.
I have the following calcScores function written:
Function calcScores(category As String) As Integer
Dim count As Integer
count = 0
For Each Ctl In UserForm1.Controls
If Ctl.Tag = category And TypeName(Ctl) = "CheckBox" Then
Dim box As MSForms.CheckBox
Set box = Ctl
If box.Value = True Then
count = count + 1
End If
End If
Next
calcScores = count
End Function
This function takes a tag named "category" as a string and then checks the form for all check boxes with that tag and counts the ones that are checked. I know it works and counts the right number, because I have slightly edited it to output it's value to a label on the form instead of returning it.
When I try to call it in another function like this:
Function sortScores()
Dim scores(0 to 5) as Integer
scores(0) = calcScores "rChk"
**CODE CONTINUES**
End Function
I get an error that says "Expected: End of Statement" as soon as I leave the line that assigns the function's return to scores(0). calcScores is assigned before sortScores, and was succesfully called in a sub before using the same syntax.
Any idea what the error could be?
Call you function like this
scores(0) = calcScores("rChk")
Functions are called like that. Subs are called by
subName argument
Long time listener, first time caller.
I am having an issue with VBA in Excel 2010. I am trying to compare various fields on a user form to determine if they are empty. I will then highlight red, and set focus on the first one on the list.
To do this, I have created functions for each type that can be blank/not selected. They are all declared AS BOOLEAN. The idea was to do the function call to highlight, pass the function calls with the appropriate sub functions, and use the results of those in the highlight function:
function Blah(DoThis01(Me.Object1), DoThis02(Me.Object2), ...) As Boolean
That gave me nojoy; the values always came back false. So I created three boolean variables to assign the values of those functions, and it started givinng me byRef errors. After declaring each variable rather than all on one line, that solved the byref, but now I get a type mismatch:
Dim foo As Boolean
foo = DoThis01(Me.Object1)
if Blah(foo, bar, ..)
It doesn't like that center line; that is where I am running into the error.
Below is the code snippet I am working with, along with an example of the functions I am trying to pass. I can't figure out why my As Boolean functions aren't compatible with an As Boolean variable. Also, the functions to determine whether or not the fields are filled are giving me some issues as well, not registering the correct values. Google had lots of answers, but none that worked for me so far. I appreciate any insight you can offer.
Thanks,
J
PS I realize some of the logic may be a bit off when triggering the message. That is ok, because I am not getting the right values anyways. I will clean it up if I can get the rest working.
Working Code:
Save Button:
Dim emptyRow As Long
Dim isDuplicate As Boolean, nameSelect As Boolean, comboSelect As Boolean, listSelect As Boolean
Dim listLength As Integer
Dim blah As Integer
' check for empty on form
nameSelect = IsSelectedName(Me.SignalNameTxtBox)
comboSelect = IsSelectedCombo(Me.ComboBox1)
listSelect = IsSelectedList(Me.ListBox1)
If HighlightEmpty(nameSelect, comboSelect, listSelect) Then
blah = MsgBox("Empty fields required!", vbOKOnly)
Exit Sub
End If
...More stuff
To Highlight Empty Form Objects:
Function HighlightEmpty(nameSelect As Boolean, comboSelect As Boolean, listSelect As Boolean) As Boolean
' Highlight empty fields
If Not nameSelect Then Enter_New_Form.SignalNameTxtBox.BackColor = RGB(255, 0, 0)
If Not comboSelect Then Enter_New_Form.ComboBox1.BackColor = RGB(255, 0, 0)
If Not listSelect Then Enter_New_Form.ListBox1.BackColor = RGB(255, 0, 0)
' Set focus to first empty field on form
If Not nameSelect Then
Enter_New_Form.SignalNameTxtBox.SetFocus
ElseIf Not comboSelect Then
Enter_New_Form.ComboBox1.SetFocus
ElseIf Not listSelect Then
Enter_New_Form.ListBox1.SetFocus
End If
' Return boolean to trigger message
HighlightEmpty = nameSelect Or comboSelect Or Not listSelect
End Function
My functions to determine if empty:
Function IsSelectedList(lst As ListBox) As Boolean
Dim I As Integer
For I = 0 To lst.ListCount - 1
IsSelectedList = lst.Selected(I)
If IsSelectedList Then Exit Function
Next I
End Function
Function IsSelectedCombo(cbo As ComboBox) As Boolean
If cbo.Value = "" Then IsSelectedCombo = False
End Function
Function IsSelectedName(nme As TextBox) As Boolean
If nme.Value = "" Then IsSelectedName = False
End Function
Your functions will always return false unless otherwise declared as true. Add an else statement like this:
Function IsSelectedName(nme As TextBox) As Boolean
If nme.Value = "" Then
IsSelectedName = False
Else
IsSelectedName = True
End If
End Function
As #Timwilliams pointed out you can reduce this to one line since nme.Value = "" will evaluate to True or False. You might find however, that you need to test if the cell is empty in other ways such as isBlank() and isEmpty(). In this case use the previous example.
Function IsSelectedName(nme As TextBox) As Boolean
IsSelectedName = Len(nme.Value) > 0
End Function
EDIT
To check the value just pass the text string to the function rather than the textbox object. Try This:
Private Sub CommandButton1_Click()
MsgBox (IsSelectedName(Me.SignalNameTxtBox.Text))
End Sub
Function IsSelectedName(nme As String) As Boolean
IsSelectedName = Len(nme) > 0
End Function