Private Sub CheckBox9_Click()
If CheckBox9.Value = True Then
CheckBox9.Caption = "Done"
ActiveWorkbook.Sheets("Well Planning Checklist").Tab.ColorIndex = 4
'ActiveSheet.Tab.ColorIndex = 22
Range("Q17").Value = CheckBox9.Caption
Else
If LCase(Range("Q17").Value) = CheckBox9.Caption Then
CheckBox9.Value = Not (CheckBox9.Value)
Else
CheckBox9.Value = Not (CheckBox9.Value)
End If
End If
End Sub
I used the above to make sure that once the user clicks checkbox, he cannot uncheck it. However, I would want to be able to have a Button that my user could user to reset .
everything and not only the checkbox. I have the below but it is not working . Could someone help me get it to work?
Private Sub CommandButton1_Click()
CheckBox9
ActiveWorkbook.Sheets("Well Design Section").CheckBox9.Caption = "Incomplete "
ActiveWorkbook.Sheets("Well Design Section").CheckBox9.Value = False
Range("Q17").Value = "Incomplete"
End Sub
To solve the problem, you can replace your CheckBox9_Click sub with this:
Private Sub CheckBox9_Click()
If CheckBox9.Value = True Then
CheckBox9.Caption = "Done"
ActiveWorkbook.Sheets("Well Planning Checklist").Tab.ColorIndex = 4
'ActiveSheet.Tab.ColorIndex = 22
Range("Q17").Value = CheckBox9.Caption
Elseif Checkbox9.Caption <> "Incomplete" Then
If LCase(Range("Q17").Value) = CheckBox9.Caption Then
CheckBox9.Value = Not (CheckBox9.Value)
Else
CheckBox9.Value = Not (CheckBox9.Value)
End If
End If
End Sub
The only difference is your Else statement is replaced with an Elseif. It will now only occur if the Caption <> "Incomplete", which is fine because the initial if will be true if the checkbox is clicked.
Related
Dears,
I want to make a simple userform to record some serial numbers into excel, it contains a textbox_serialNo., a command button “enter” and another command button “cancel”.
I made a validation control in that serialNo textbox so that only number can be entered. However, when I run the program and input some numbers into the textbox, both command buttons (the "enter" button named as label_enter,the "cancel" button named as label_cancel) have no reactions (e.g. the "cancel" button doesn't unload the form when press) , how should I correct the program? Below are the relevant codes, Thanks.
Private Sub TextBox_SerialNo_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsNumeric(TextBox_SerialNo.Value) Then
TextBox_SerialNo.BackColor = rgbYellow
End If
Cancel = True
End Sub
Private Sub TextBox_SerialNo_AfterUpdate()
If TextBox_SerialNo.Value <> "" Then
TextBox_SerialNo.BackColor = rgbWhite
End If
End Sub
Private sub label_enter_click()
sheet1.Select
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
ActiveCell.Offset(0, 1) = TextBox_SerialNo.Value
TextBox_SerialNo.Value = ""
End Sub
Private Sub Label_Cancel_Click()
Unload Me
End Sub
Sorry to be posting as an answer, not enough rep.
Shouldn't Cancel=True be inside the if statement? You are locking it up regardless of entry being numeric or not as is.
Edit:
Actually upon further testing still not working proper. However, change event works better and you can get instant feedback for any non numerics.
Updated code would look like this, control names differ. I am used to working with .Text, same thing as .Value. Also, since I am not sure what you would do with an empty string, assumed it to be yellow background as well.
One concern would be, can you allow comma or period in there? Depending on locale settings, a decimal would also be considered a numeric.
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdEnter_Click()
If TextBox1.BackColor = rgbYellow Then Exit Sub
test4.Range("A1").Value = TextBox1.Text
End Sub
Private Sub TextBox1_Change()
If Not IsNumeric(TextBox1.Text) Or TextBox1.Text = "" Then
TextBox1.BackColor = rgbYellow
Else
If TextBox1.Text <> "" Then
TextBox1.BackColor = rgbWhite
End If
End If
End Sub
Edit 2: I use this piece of code to check for only numbers (assuming number Ascii codes are standard). Maybe it can help.
Public Function isnumber(ByVal strValue As Variant) As Boolean
On Error Resume Next
Dim i As Long
isnumber = True
If Not strValue = "" Then
For i = 1 To Len(CStr(strValue))
If Asc(Mid(strValue, i, 1)) > 57 Or Asc(Mid(strValue, i, 1)) < 48 Then
isnumber = False
Exit For
End If
Next i
Else
isnumber = False
End If
On Error GoTo 0
Err.Clear
End Function
Edit 3: I have revised the TextBox1_Change event code so all invalid characters are stripped right away. However, in this state if you copy paste a serial no with a non-allowed char, it will strip them leaving only the numbers. Not sure if it is acceptable.
Private Sub TextBox1_Change()
If Not isnumber(TextBox1.Text) Or TextBox1.Text = "" Then
TextBox1.BackColor = rgbYellow
Dim i As Long
Dim strValue As String
strValue = ""
If Not TextBox1.Text = "" Then
For i = 1 To Len(CStr(TextBox1.Text))
If Not (Asc(Mid(TextBox1.Text, i, 1)) > 57 Or Asc(Mid(TextBox1.Text, i, 1)) < 48) Then
strValue = strValue & Mid(TextBox1.Text, i, 1)
End If
Next i
End If
TextBox1.Text = strValue
Else
If TextBox1.Text <> "" Then
TextBox1.BackColor = rgbWhite
End If
End If
End Sub
Hi guys I’m trying to make a fill-in form where certain rows get hidden when certain options are selected
the first part of the script works perfectly but adding a second optional cell (B31) seems to be problematic
can’t get it to work
can someone please help?
this is the script I found on the internet and adapted to my purpose
Private Sub worksheet_change(ByVal Target As Range)
If Target.Address = ("$B$6") Then
If Target.Text = "Pollution" Then
Rows("21:28").EntireRow.Hidden = False
Rows("29:97").EntireRow.Hidden = True
ElseIf Target.Text = "Select option" Then
Rows("21:97").EntireRow.Hidden = True
ElseIf Target.Text = "Fire" Then
Rows("21:29").EntireRow.Hidden = True
Rows("30:42").EntireRow.Hidden = False
Rows("43:97").EntireRow.Hidden = True
ElseIf Target.Text = "Collision, Grounding & Stranding" Then
Rows("21:43").EntireRow.Hidden = True
Rows("44:57").EntireRow.Hidden = False
Rows("58:97").EntireRow.Hidden = True
ElseIf Target.Text = "Technical Failure" Then
Rows("21:58").EntireRow.Hidden = True
Rows("59:67").EntireRow.Hidden = False
Rows("68:97").EntireRow.Hidden = True
ElseIf Target.Text = "Crew member missing / Man over board" Then
Rows("21:68").EntireRow.Hidden = True
Rows("69:79").EntireRow.Hidden = False
Rows("80:97").EntireRow.Hidden = True
ElseIf Target.Text = "Injury / Fatality" Then
Rows("21:80").EntireRow.Hidden = True
Rows("81:87").EntireRow.Hidden = False
Rows("88:97").EntireRow.Hidden = True
ElseIf Target.Text = "Cargo shift / damage" Then
Rows("21:88").EntireRow.Hidden = True
Rows("89:97").EntireRow.Hidden = False
End If
If Target.Address = ("$B$31") Then
If Target.Text = "Engine room" Then
Rows("40:42").EntireRow.Hidden = True
Rows("30:39").EntireRow.Hidden = False
End If
End If
End If
End Sub
Thanks in advance
Your If blocks are nested wrongly. Try something like this - note it's easier to only unhide the rows you want after first hiding everything.
Private Sub worksheet_change(ByVal Target As Range)
If Target.Address = ("$B$6") Then
Me.Rows("21:97").EntireRow.Hidden = True 'hide everything
'...then unhide only the required rows
Select Case Target.Text
Case "Pollution":
Me.Rows("21:28").EntireRow.Hidden = False
Case "Fire":
Me.Rows("30:42").EntireRow.Hidden = False
Case "Collision, Grounding & Stranding":
Me.Rows("44:57").EntireRow.Hidden = False
Case "Technical Failure":
Me.Rows("59:67").EntireRow.Hidden = False
Case "Crew member missing / Man over board":
Me.Rows("69:79").EntireRow.Hidden = False
Case "Injury / Fatality":
Me.Rows("81:87").EntireRow.Hidden = False
Case "Cargo shift / damage":
Me.Rows("89:97").EntireRow.Hidden = False
End Select
End If
If Target.Address = ("$B$31") Then
If Target.Text = "Engine room" Then
Me.Rows("40:42").EntireRow.Hidden = True
Me.Rows("30:39").EntireRow.Hidden = False
End If
End If
End Sub
You have a predetermined patten for selecting which rows will be shown and which will not. Consequently it is possible to refactor your code so that no 'If/ElseIf/End' are required for the actions of showing/hiding rows.
There is nothing wrong with using 'if', 'if then else' etc so I'm providing the code below as an exercide in how to think differently.
I'm not a user of Excel so my apologies in advance if I've made any mistakes in the Excel object syntax.
The code compiles without errors and generates no unexpected code inspection results with RubberDuck.
Option Explicit
Private Type State
JumpRanges As Scripting.Dictionary
B6JumpTable As Scripting.Dictionary
B31JumpTable As Scripting.Dictionary
End Type
Private s As State
Private Sub worksheet_change(ByVal Target As Range)
If s.JumpRanges Is Nothing Then InitialiseJumpTables
ActiveSheet.Rows.Item("21:97").EntireRow.Hidden = True
If s.JumpRanges.exists(Target.Address) Then
ActiveSheet.Rows(s.JumpRanges.Item(Target.Address).Item(Target.Text)).EntireRow.Hidden = False
Else
Err.Raise _
17, _
"Range Error", _
"The range " & Target.Address & "does not exist in the JumpRanges dictionary"
End If
End Sub
Public Sub InitialiseJumpTables()
Set s.B6JumpTable = New Scripting.Dictionary
With s.B6JumpTable
.Add "Pollution", "21:28"
.Add "Select option", "21:97"
.Add "Fire", "30:42"
.Add "Collision, Grounding & Stranding", "44:57"
.Add "Technical Failure", "59:67"
.Add "Crew member missing / Man over board", "69:79"
.Add "Injury / Fatality", "81:87"
.Add "Cargo shift / damage", "81:87"
End With
Set s.B31JumpTable = New Scripting.Dictionary
With s.B31JumpTable
.Add "Engine room", "30:39"
End With
Set s.JumpRanges = New Scripting.Dictionary
With s.JumpRanges
.Add "$B$6", s.B6JumpTable
.Add "$B$31", s.B31JumpTable
End With
End Sub
I have created a login screen to authenticate into the excel workbook if a valid password is entered.
code is as below:
Private Sub CommandButton1_Click()
name_selected = ComboBox1.Text
pwd_entered = TextBox2.Text
validation_sheet = "Z"
act_p_col_num = 3
Application.Visible = True
For validation_check = 2 To Worksheets(validation_sheet).Cells(Rows.Count, 1).End(xlUp).Row - 1
If (Worksheets(validation_sheet).Cells(validation_check, 1) = name_selected) Then
bk_pd = Worksheets(validation_sheet).Cells(validation_check, act_p_col_num).Value
If (bk_pd = pwd_entered) Then
Worksheets("INDIVIDUAL_TRACKER").Select
MsgBox ("Authentication successful")
UserForm1.Hide
'Set UserForm1.Visible = False
Else
Application.Visible = False
MsgBox ("Please enter a valid password! Account will be locked after 3 tries")
TextBox2.Text = ""
End If
End If
Next validation_check
End Sub
However this code has been tried using the unload me command and userform1.hide too which is still throwing me a run time error 424,object required.
My objective is to go to the workbook once the authentication passes and the userform should be closed automatically.
Can someone help me in resolving this ?
My guess is that the next iteration of the for loop is what is actually causing the problem. You try to access the TextBox on the if statement when the form has been unloaded.
Try including the line
Exit For
After Unload Me
Reshuffling the application.visible=True lines has solved the purpose. Using it in the right place has made it work well.And a use of Exit For has been an added advantage.
Private Sub CommandButton1_Click()
name_selected = ComboBox1.Text
pwd_entered = TextBox2.Text
validation_sheet = "Z"
act_p_col_num = 3
Application.Visible = True
For validation_check = 2 To Worksheets(validation_sheet).Cells(Rows.Count, 1).End(xlUp).Row - 1
If (Worksheets(validation_sheet).Cells(validation_check, 1) = name_selected) Then
bk_pd = Worksheets(validation_sheet).Cells(validation_check, act_p_col_num).Value
If (bk_pd = pwd_entered) Then
Unload Me
'UserForm1.Hide
'Set UserForm1.Visible = False
Application.Visible = True
Worksheets("INDIVIDUAL_TRACKER").Select
MsgBox ("Authentication successful")
Exit For
Else
'Application.Visible = False
MsgBox ("Please enter a valid password! Account will be locked after 3 tries")
TextBox2.Text = ""
End If
End If
Next validation_check
End Sub
Thanks to everyone who has shed some light on this issue.It was a good brainstorming.Thanks everyone.The issue stands resolved now.
This question already has answers here:
Why MS Excel crashes and closes during Worksheet_Change Sub procedure?
(3 answers)
Closed 4 years ago.
When I run this code and select yes in the cell "bulk" I keep receiving "please enter the number of labor hours" over and over.
Basically what my goal is to have a drop down list to show hidden rows. Then if yes is selected in another drop down list, then two additional box inputs show up
Private Sub worksheet_change(ByVal target As Range)
ActiveSheet.Activate
Rows("20:22").EntireRow.Hidden = True
Rows("23:26").EntireRow.Hidden = True
Rows("27:30").EntireRow.Hidden = True
Rows("51:56").EntireRow.Hidden = True
If Not Application.Intersect(Range("Change"), Range(target.Address)) Is Nothing Then
Select Case target.Value
Case Is = "Asset Transfer": Rows("20:22").EntireRow.Hidden = False
Rows("23:26").EntireRow.Hidden = True
Rows("27:30").EntireRow.Hidden = True
Rows("51:56").EntireRow.Hidden = True
Case Is = "Fund Lineup": Rows("27:30").EntireRow.Hidden = False
Rows("20:22").EntireRow.Hidden = True
Rows("23:26").EntireRow.Hidden = True
Rows("51:56").EntireRow.Hidden = True
Case Is = "Plan Merge": Rows("23:26").EntireRow.Hidden = False
Rows("20:22").EntireRow.Hidden = True
Rows("27:30").EntireRow.Hidden = True
Rows("51:56").EntireRow.Hidden = True
Case Is = "Loans": Rows("51:56").EntireRow.Hidden = False
Rows("27:30").EntireRow.Hidden = True
Rows("20:22").EntireRow.Hidden = True
Rows("23:26").EntireRow.Hidden = True
Rows("28:31").EntireRow.Hidden = True
End Select
End If
Set target = Range("bulk")
If target.Value = "Yes" Then
Dim QtyEntry As Integer
Dim Msg As String
Msg = "Please enter the number of labor hours'"
QtyEntry = InputBox(Msg)
ActiveSheet.Range("c60").Value = QtyEntry
Dim Entry As Integer
Dim Msg1 As String
Msg1 = "Enter percentage increase'"
Entry = InputBox(Msg1)
ActiveSheet.Range("d60").Value = Entry
End If
End Sub
Once your cell has been changed, you can disable events right away, and then re-enable them before exiting the sub.
Also, you start the sub by hiding columns so there is no need to hide them again in your Select Case. All you need to do here is un-hide the rows that you want to be visible.
Also #2, are you sure you don't want your 2nd if statement inside your first if statement? As is, any change will prompt your input boxes.
You can reduce your code to this, which makes your logic a little easier to follow. The main take away is to notice that nothing is done outside of the events being disabled.
Option Explicit
Private Sub worksheet_change(ByVal target As Range)
Application.EnableEvents = False
Union(Rows("20:30"), Rows("51:56")).EntireRow.Hidden = True
If Not Application.Intersect(Range("Change"), Range(target.Address)) Is Nothing Then
Select Case target.Value
Case "Asset Transfer"
Rows("20:22").EntireRow.Hidden = False
Case "Fund Lineup"
Rows("27:30").EntireRow.Hidden = False
Case "Plan Merge"
Rows("23:26").EntireRow.Hidden = False
Case "Loans"
Rows("51:56").EntireRow.Hidden = False
End Select
'Do you want your second IF statement here?
End If
If Range(“bulk”) = "Yes" Then
Range("C60") = InputBox("Please enter the number of labor hours'")
Range("D60") = InputBox("Enter Percentage Increase'")
End If
Application.EnableEvents = True
End Sub
You will likely need to add some validation/error handling for both of your input boxes. What happens if the user puts "one" for number of labor hours? I recommend looking into Application.InputBox so you can control for the input.
I have this VBA code that worked perfectly fine before yet suddenly not anymore. It returns
application-defined or object defined error
now, when I watched the failed line, it says
expression not defined in context
Basically, what this macro does is to let people choose pivot table filters by several times in a group, rather than one by one. Below is the code, any help will be strongly appreciated.
Sub AdvancedFilter1()
Dim ws
Set ws = Workbooks("Bayer IB.xlsm").Worksheets("Pivots")
ws.Activate
Dim pv3
Dim pv4
Set pv3 = ws.PivotTables("PivotTable3").PivotFields("Shipped Date FY")
Set pv4 = ws.PivotTables("PivotTable4").PivotFields("Shipped Date FY")
Workbooks("Bayer IB.xlsm").Worksheets("Pivots").Activate
If ws.Range("B1").Activate Then
If ActiveCell.Value = "10" Then
With pv3
.PivotItems("2007").Visible = True
.PivotItems("2008").Visible = True
.PivotItems("2009").Visible = True
.PivotItems("2010").Visible = True
.PivotItems("2011").Visible = True
.PivotItems("2012").Visible = True
.PivotItems("2013").Visible = True
.PivotItems("2014").Visible = True
.PivotItems("2015").Visible = True
.PivotItems("2016").Visible = True
End With
ElseIf ActiveCell.Value = "2" Then
With pv3
.PivotItems("2007").Visible = False
.PivotItems("2008").Visible = False
.PivotItems("2009").Visible = False
.PivotItems("2010").Visible = False
.PivotItems("2011").Visible = False
.PivotItems("2012").Visible = False
.PivotItems("2013").Visible = False
.PivotItems("2014").Visible = False
.PivotItems("2015").Visible = True
.PivotItems("2016").Visible = True
End With
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Address
Case "$B$1"
If Target = "10" Then
Call AdvancedFilter1
ElseIf Target = "2" Then
Call AdvancedFilter1
ElseIf Target = "3" Then
Call AdvancedFilter1
ElseIf Target = "5" Then
Call AdvancedFilter1
ElseIf Target = "7" Then
Call AdvancedFilter1
End If
'TO PREVENT AUTOMATIC REDIRECT TO 'J3'
Range("B1").Select
End Select
End Sub
Just want to add an update to this question... I used the same code in another file, and it worked there. I still don't know why it won't work before, but this code is working out now, though in another workbook...
Thanks anyone who took time reading this and #findwindow's assistant.