(1*8)+(2*8)+(3*8)+(4*8)+(5*8) be written as (1+2+3+4+5)*8.
How can I simplify the code below in a similar way?
Private Sub CommandButton1_Click()
Label1.BackColor = &H8000000F
Label2.BackColor = &H8000000F
Label3.BackColor = &H8000000F
Label4.BackColor = &H8000000F
Label5.BackColor = &H8000000F
End Sub
Actually I have heard of a solution that uses With, but so far I never get to see them applied in PowerPoint.
you can't use With keyword for such a task
but you can do this:
Private Sub CommandButton1_Click()
Dim i As Long
For i = 1 To 5
Me.Controls("Label" & i).BackColor = &H8000000F
Next i
End Sub
Create a range for the labels and call it by range as opposed to label.
Private Sub CommandButton1_Click()
rangeName = &H8000000F
End Sub
Related
I have a button in the "code module" which runs a request. Next to the Button is a label included which shows a check mark a soon as the button has finished running.
The button code is in the code modul. The codes for the label with the check mark is inlcuded in the workbook and sheet modul.
Now, the issue is when I push the button it runs perfectly fine and does what it supposed to but the label with the check mark does not get activated. The reason might be because I have not included/referenced the workbook/sheet modul in my code modul. Hope for a bit help.
Code in workbook Module:
Option Explicit
Private Sub Workbook_Open()
Call Tabelle1.prcResetLabels
End Sub
Code in Sheet Module:
Option Explicit
Private Sub Schaltfläche2_Klicken()
Call prcSetLabel(probjLabel:=Label1)
End Sub
Private Sub prcSetLabel(ByRef probjLabel As MSForms.Label)
With probjLabel
.Caption = "P"
End With
End Sub
Friend Sub prcResetLabels()
Dim objOLEObject As OLEObject
For Each objOLEObject In OLEObjects
With objOLEObject
If .progID = "Forms.Label.1" Then _
.Object.Caption = vbNullString
End With
Next
End Sub
Code in Codemodul:
Public Sub Schaltfläche2_Klicken()
With Sheets("Table1")
.Range("A1").End(xlUp).Offset(1, 0).Value = Environ("USERNAME")
End With
End Sub
The answer ist simple this:
Sub Schaltfläche2_Klicken()
Call prcResetLabels
With Sheets("Table1")
.Range("A1").End(xlUp).Offset(1, 0).Value = Environ("USERNAME")
End With
Call prcSetLabel(probjLabel:=Table1.Label1)
End Sub
Private Sub prcSetLabel(ByVal probjLabel As Object)
With probjLabel
.Object.Caption = "P"
End With
End Sub
Public Sub prcResetLabels()
Dim objOLEObject As OLEObject
For Each objOLEObject In Table1.OLEObjects
With objOLEObject
If .progID = "Forms.Label.1" Then _
.Object.Caption = vbNullString
End With
Next
End Sub
I want to add dynamically CommandButtons to my Userform within the For-Loop. How can i get add new CommandButtons in the For-Loop?
Dim CommandButtons(5) As clsCommandButtons
Private Sub UserForm_Initialize()
Dim zaehler As Integer
For zaehler = 0 To 4
Set CommandButtons(zaehler) = New clsCommandButtons
Set CommandButtons(zaehler).cmdCommandButton = Me.Controls(zaehler)
Next
End Sub
And This is my class:
Option Explicit
Public WithEvents cmdCommandButton As CommandButton
Private Sub cmdCommandButton_Click()
Dim sFilepath As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.InitialFileName = ActiveWorkbook.Path & "\"
.Filters.Add "TextFiles", "*.txt", 1
.FilterIndex = 1
If .Show = -1 Then
sFilepath = .SelectedItems(1)
End If
End With
Cells(c_intRowFilterPathStart, c_intClmnFilterPath) = sFilepath
End Sub
I don't know how to handle this Error. How can i fix this?
I assume you get the error because you're accessing a control that doesn't exist. Note that the controls are counted from 0 to Me.Controls.count-1, so probably your issue is solved with
Set CommandButtons(zaehler).cmdCommandButton = Me.Controls(zaehler-1)
But I guess a better solution is to name your buttons and assign them by name:
Set CommandButtons(zaehler).cmdCommandButton = Me.Controls("CommandButton" & zaehler)
Define the CommandButtons collection as a Variant:
Dim CommandButtons(15) As Variant, instead of Dim CommandButtons(15) As clsCommandButtons.
In this Variant, you would put your CommandButtons. This is some minimal code, that would help you get the basics of what I mean:
CustomClass:
Private Sub Class_Initialize()
Debug.Print "I am initialized!"
End Sub
In a module:
Private SomeCollection(4) As Variant
Public Sub TestMe()
Dim cnt As Long
For cnt = 1 To 4
Set SomeCollection(cnt) = New CustomClass
Next cnt
End Sub
From this small running code, you can start debugging further :)
I think your problem is in the Me.Controls(zaehler) part. zaehler starts at 1, but Me.Controls(...) starts at 0.
Set CommandButtons(zaehler).cmdCommandButton = Me.Controls(zaehler - 1)
would probably solve it
Dim a() As clsCommandButton
Private Sub UserForm_Initialize()
Dim c As Control
On Error GoTo eHandle
For Each c In Me.Controls
If TypeName(c) = "CommandButton" Then
ReDim Preserve a(UBound(a) + 1)
Set a(UBound(a)) = New clsCommandButton
Set a(UBound(a)).cmd = c
End If
Next c
Exit Sub
eHandle:
If Err.Number = 9 Then
ReDim a(0)
End If
Resume Next
End Sub
With a class as follows
Public WithEvents cmd As commandbutton
Private Sub cmd_Click()
MsgBox "test"
End Sub
I have a combo box drop down with search suggestions, made from code here:
http://trumpexcel.com/2013/10/excel-drop-down-list-with-search-suggestions/
It works very well, but when I'm on another sheet and pressing "Enter", the search field randomly pops up in the sheet
It's not even the full box, just the blue field
Any insights on disabling it? The only success I've had is turning calculation to manual, but the workbook needs automatic calculation
Thanks!
I ran into a similar issue with my own VBA version of a smart search bar. How I fixed it was by doing the following:
Private Sub ComboBox1_Change()
If ComboBox1.Value = "" Then Exit Sub '<------ Problem solved.
ComboBox1.ListFillRange = "DropDownList"
Me.ComboBox1.DropDown
End Sub
OR
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim SheetWithComboBox As Worksheet: Set SheetWithComboBox = ThisWorkbook.Sheets(1)
If ThisWorkbook.ActiveSheet.Name <> SheetWithComboBox.Name Then
ComboBox1.Visible = False
Else: ComboBox1.Visible = True
End If
End Sub
#Tyeler
Thanks for your help, your thinking helped me think of a way
Private Sub ComboBox1_change()
Dim sht1 As Worksheet
Set sht1 = Worksheets("xxx")
If ThisWorkbook.ActiveSheet.Name = sht1.Name Then
ComboBox1.ListFillRange = "DropDownList"
Me.ComboBox1.DropDown
Call macro1
Else: Exit Sub
End If
End Sub
I found a solution that, at least for me, works for all sheets.
Private Sub Combobox_Get_Focus()
ComboBox1.ListFillRange = "DropDownList"
Me.ComboBox1.DropDown
End Sub
Say you have aUserForm with TextBox1, TextBox3, TextBox3 and an OK Button.
To only allow the UserForm to close if all three TextBox have data I would use the following script assigned to the OK Button:
Private Sub CommandButton1_Click()
If Len(TextBox1.Value) >= 1 And _
Len(TextBox2.Value) >= 1 And _
Len(TextBox3.Value) >= 1 Then
Me.Hide
Else
MsgBox "Please Complete All Fields!"
End If
End Sub
Is there another way to do this besides an If statement?
Direct User Before Errors Are Made
Preferable to informing a user after an invalid action has been made is to prevent the user from performing that invalid action in the first place[1]. One way to do this is to use the Textbox_AfterUpdate event to call a shared validation routine that controls the Enabled property of your OK button, and also controls the display of a status label. The result is a more informative interface that only allows valid actions, thereby limiting the nuisance of msgbox popups. Here's some example code and screenshots.
Private Sub TextBox1_AfterUpdate()
RunValidation
End Sub
Private Sub TextBox2_AfterUpdate()
RunValidation
End Sub
Private Sub TextBox3_AfterUpdate()
RunValidation
End Sub
Private Sub RunValidation()
If Len(TextBox1.Value) = 0 Or Len(TextBox2.Value) = 0 Or Len(TextBox3.Value) = 0 Then
CommandButton1.Enabled = False
Label1.Visible = True
Else
CommandButton1.Enabled = True
Label1.Visible = False
End If
End Sub
Private Sub CommandButton1_Click()
Me.Hide
End Sub
The If Statement
As far as the If statement is concerned, there are a ton of ways that can be done, but I think anything other than directly evaluating TextBox.Value leads to unnecessary plumbing and code complexity, so I think it's hard to argue for anything other than the If statement in the OP. That being said, this particular If statement can be slightly condensed by capitalizing on its numeric nature, which allows for
Len(TextBox1.Value) = 0 Or Len(TextBox2.Value) = 0 Or Len(TextBox3.Value) = 0
to be replaced with
Len(TextBox1.Value) * Len(TextBox2.Value) * Len(TextBox3.Value) = 0
Although that doesn't gain you much and is arguably less readable code, it does allow for a condensed one liner, especially if the textboxes are renamed...
If Len(TB1.Value) * Len(TB2.Value) * Len(TB3.Value) = 0 Then
.Value vs .Text
Lastly, in this case, I think .Value should be used instead of .Text. .Text is more suited for validating a textbox entry while its being typed, but in this case, you're looking to validate a textbox's saved data, which is what you get from .Value.
More User feedback - Colorization
I almost forgot, I wanted to include this example of how to include even more user feedback. There is a balance between providing useful feedback and overwhelming with too much. This is especially true if the overall form is complicated, or if the intended user has preferences, but color indication for key fields is usually beneficial. A lot of applications may present the form without color at first and then colorize it if the user is having trouble.
Private InvalidColor
Private ValidColor
Private Sub UserForm_Initialize()
InvalidColor = RGB(255, 180, 180)
ValidColor = RGB(180, 255, 180)
TextBox1.BackColor = InvalidColor
TextBox2.BackColor = InvalidColor
TextBox3.BackColor = InvalidColor
End Sub
Private Sub TextBox1_AfterUpdate()
RunValidation Me.ActiveControl
End Sub
Private Sub TextBox2_AfterUpdate()
RunValidation Me.ActiveControl
End Sub
Private Sub TextBox3_AfterUpdate()
RunValidation Me.ActiveControl
End Sub
Private Sub RunValidation(ByRef tb As MSForms.TextBox)
If Len(tb.Value) > 0 Then
tb.BackColor = ValidColor
Else
tb.BackColor = InvalidColor
End If
If Len(TextBox1.Value) * Len(TextBox2.Value) * Len(TextBox3.Value) = 0 Then
CommandButton1.Enabled = False
Label1.Visible = True
Else
CommandButton1.Enabled = True
Label1.Visible = False
End If
End Sub
Private Sub CommandButton1_Click()
Me.Hide
End Sub
As I said in my comment, that is an ok way to do it. But i'll post this just so you have an example of another way. This would allow you to evaluate what is going into the text boxes as they are set.
Option Explicit
Dim bBox1Value As Boolean
Dim bBox2Value As Boolean
Dim bBox3Value As Boolean
Private Sub TextBox1_Change()
If Trim(TextBox1.Text) <> "" Then
bBox1Value = True
End If
End Sub
Private Sub TextBox2_Change()
If Trim(TextBox2.Text) <> "" Then
bBox2Value = True
End If
End Sub
Private Sub TextBox3_Change()
If Trim(TextBox3.Text) <> "" Then
bBox3Value = True
End If
End Sub
Private Sub CommandButton1_Click()
If bBox1Value = True And bBox2Value = True And bBox3Value = True Then
Me.Hide
Else
MsgBox "Please Complete All Fields!"
End If
End Sub
You can use a loop:
Private Sub CommandButton1_Click()
Dim n as long
For n = 1 to 3
If Len(Trim(Me.Controls("TextBox" & n).Value)) = 0 Then
MsgBox "Please Complete All Fields!"
Exit Sub
End If
Next n
Me.Hide
End Sub
You can use the below code
Private Sub CommandButton1_Click()
If Trim(TextBox1.Value & vbNullString) = vbNullString And _
Trim(TextBox2.Value & vbNullString) = vbNullString And _
Trim(TextBox3.Value & vbNullString) = vbNullString Then
Me.Hide
Else
MsgBox "Please Complete All Fields!"
End If
End Sub
I got the answer from this question
VBA to verify if text exists in a textbox, then check if date is in the correct format
I have a Excel workbook calculator dependent on a few parameters. I want the client to be able to insert those parameters into an appropriate "client input" cell on every spreadsheet so he doesn't have to jump back and forth between spreadsheets.
Is there a good way to do it? I tried the following scheme, but it's buggy for reasons unknown to me:
make a VBA module declaring variables to hold my parameters
initialize them with appropriate initial values on the Workbook_Open event
make the specific sheets write those values into "client input" cells on Worksheet_Activate event
in a Worksheet_Deactivate event, if the "client input" cells are different among each other - update the VBA variables
This works sometimes, but not always. Is there a better way to do this?
EDIT:
This is my "GM" Module:
Option Explicit
Public perspective As String
Public RSS As String
Public Payback As Double
This is my "ThisWorkbook:
Private Sub Workbook_Open()
GM.perspective = Worksheets("Hidden variables").Range("A1").Value
GM.RSS = Worksheets("Hidden variables").Range("B2").Value
GM.Payback = Worksheets("Hidden variables").Range("C3").Value
End Sub
Private Sub Workbook_Close()
Worksheets("Hidden variables").Range("A1") = GM.perspective
Worksheets("Hidden variables").Range("B2") = GM.RSS
Worksheets("Hidden variables").Range("C3") = GM.Payback
End Sub
This is in my worksheet 1 (in worksheet 2 there is an analogous code):
Option Explicit
Private Sub Worksheet_Activate()
'SIMULTANEOUS UPDATE p.1
Worksheets("1").Range("I32") = GM.Payback
Worksheets("1").Range("I29") = GM.RSS
Worksheets("1").Range("I26") = GM.perspective
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'BASIC PRICE CALCULATION
If Target.Count > 1 Then Exit Sub
If Target = Range("I32") _
Or Target = Range("I29") _
Or Target = Range("I26") _
Or Target = Worksheets("Intro").Range("price") _
Then
Worksheets("Hidden variables").Range("condition") = 2
Worksheets("Hidden variables").Range("basic_price") = Worksheets("Intro").Range("price").Value
Range("M44").GoalSeek Goal:=0, ChangingCell:=Worksheets("Hidden variables").Range("basic_price")
If Worksheets("Hidden variables").Range("basic_price").Value < 0 Then
Range("M46") = "Error"
Else
Range("M46") = Worksheets("Hidden variables").Range("basic_price").Value
End If
Worksheets("Hidden variables").Range("condition") = 1
End If
End Sub
Private Sub Worksheet_Deactivate()
'SIMULTANEOUS UPDATE p.2
GM.Payback = Worksheets("1").Range("I32").Value
GM.RSS = Worksheets("1").Range("I29").Value
GM.perspective = Worksheets("1").Range("I26").Value
End Sub
To avoid infinite loop, you can use a global variable
Outside a function (at the begin of your module)
Public isUpdating As Double
inside your Worksheet_change
Private Sub Worksheet_Change(ByVal Target As Range)
' Check if an update is in progress. If so, exit the change
if isUpdating then
exit sub
end if
' Begin of the update
isUpdating = true
' Here your update
' End of the update
isUpdating = false
End sub