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.
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
This is a question mainly to understand and learn, then to find a solution, since i know what causes the problem and made a workaround.
I get Run-time error '-2147417848 (80010108)': Method 'Value' of object 'Range' failed.
I have a main UserForm with a ListBox, it gets filled from a table. Then i have a secondary UserForm to make new entries in said table. That table is on my sheet shData("Daten") and is called "mainData". If just run the secondary form to make new entry, all is fine. But if i start the secondary form from main form, i get the error.
This is the code in main form.
Private Sub newEntryButton_Click()
newEntry.Show
End Sub
Private Sub UserForm_Activate()
mainListUpdate
End Sub
This is the code in secondary form
Private Sub doneButton_Click()
Dim n As Long
n = cRow + 1
shData.Range("A" & n).Value = nameBox.Value
shData.Range("B" & n).Value = paraBox.Value
shData.Range("C" & n).Value = hStartBox.Value
shData.Range("D" & n).Value = bdayBox.Value
If OptionButtonStat.Value = True Then
shData.Range("E" & n).Value = "Ja"
shData.Range("G" & n).Value = statPlaceBox.Value
ElseIf OptionButtonAmb.Value = True Then
shData.Range("F" & n).Value = "Ja"
End If
Me.Hide
End Sub
Private Sub OptionButtonStat_Change()
If OptionButtonStat.Value = True Then
Me.statPlaceBox.Visible = True
Me.statPlaceLab.Visible = True
Else
Me.statPlaceBox.Visible = False
Me.statPlaceLab.Visible = False
End If
End Sub
Public Sub UserForm_Activate()
Me.statPlaceBox.Visible = False
Me.statPlaceLab.Visible = False
End Sub
and this is the code in a module.
Public cRow As Long
Public cCol As Long
Public Sub mainListUpdate()
If shData.FilterMode = True Then
shData.ShowAllData
End If
cRow = shData.Range("A1").CurrentRegion.Rows.Count
cCol = shData.Range("A1").CurrentRegion.Columns.Count
formMain.listMain.ColumnCount = cCol
formMain.listMain.ColumnHeads = True
formMain.listMain.RowSource = "mainData"
End Sub
The error occurs on the following line in secondary form code: shData.Range("A" & n).Value = nameBox.Value. If i change formMain.listMain.RowSource = "mainData" in the module code to formMain.listMain.RowSource = "Daten!A2:G", the problem disappears. Again, the code works fine with the table as RowSource, if i just use the secondary form, just need to add cRow = shData.Range("A1").CurrentRegion.Rows.Count.
I hope, i explained it well enough. Can somebody please explain, why i have this problem? It was very frustrating to search for the issue and i really would like to use the original code.
I am trying to create code that runs through a list of user ID's (B Numbers) and then when it finds the corresponding ID it checks to see if there's an X in the column directly next to it for a certain subject named SBB005 See image. If there is an X, I want the check box value to be true. The for each loop ends when it reaches a blank cell.
I have declared the 'RowYear2' and 'Year2CourseRange' ranges as public variables, and when running the code, nothing happens and the check box remains unticked! Any idea why the checkbox isn't being ticked as expected?
I am planning on setting up multiple checkboxes once this is working for all the subjects in each column:
See image
Hoping that someone can help me to get this working or may even introduce an easier way to do so for another 20 checkboxes!
Many thanks :)
Private Sub UserForm_Initialize()
Set Year2CourseRange = Sheets("Year2").Range("A:A")
For Each RowYear2 In Year2CourseRange.Cells
If RowYear2.Value = BNumberTxt Then
If RowYear2.Offset(0, 1) = "x" Then
Me.CHKSBB005.value = True
Else
Me.CHKSBB005.value = False
End If
ElseIf IsEmpty(RowYear2) Then
Exit For
End If
Next RowYear2
LoggedInTxt = Row.Offset(0, -3)
BNumberTxt = Row.Offset(0, -7)
CourseTxt = Row.Offset(0, -1)
CourseNumTxt = Row.Offset(0, -2)
End Sub
Private Sub EnterBtn_Click()
Dim LIMatch As Boolean
Dim Win As Boolean
Email = Me.EmailTxt
Password = Me.PasswordTxt
Set UserRange = Sheets("StudentInformation").Range("H:H")
For Each Row In UserRange.Cells
If Me.EmailTxt = "" And Me.PasswordTxt = "" Then
MsgBox ("Please enter an email and password")
LIMatch = False
Win = True
Exit For
ElseIf Me.EmailTxt = "" Then
MsgBox ("Please enter an email address")
LIMatch = False
Win = True
Exit For
ElseIf Me.PasswordTxt = "" Then
MsgBox ("Please enter a password")
LIMatch = False
Win = True
Exit For
Else
If UCase(Row.Value) = UCase(Email) Then
If UCase(Row.Offset(0, -6)) = UCase(Password) Then
MsgBox "Welcome"
LIMatch = True
Win = True
Attempts = 0
Exit For
ElseIf IsEmpty(Row) Then
Exit For
Win = False
Else
LIMatch = False
Win = False
Exit For
End If
Else
LIMatch = False
Win = False
End If
End If
Next Row
If LIMatch = True And Win = True Then
Unload Me
NewForm.Show
ElseIf LIMatch = False And Win = False Then
MsgBox ("Incorrect login")
Attempts = Attempts + 1
Else
End If
If Attempts >= 3 Then
MsgBox ("You have entered the incorrect login 3 times")
Unload Me
End If
End Sub
Once you fix your problem with the Row global, you can do something like this:
Private Sub UserForm_Initialize()
Dim shtData As Worksheet
Dim Year2CourseRange As Range, HeaderRange As Range, m, c As Range
Set shtData = ThisWorkbook.Sheets("Year2")
With shtData
Set Year2CourseRange = .Range("A:A")
Set HeaderRange = .Range(.Range("B2"), .Cells(2, 500).End(xlToLeft))
End With
'you'll need to fix this part....
BNumberTxt = Row.Offset(0, -7)
'etc
'find a matching row: Match() is a good approach here
m = Application.Match(BNumberTxt, Year2CourseRange, 0)
'loop over all the column headers
For Each c In HeaderRange.Cells
'Assumes all checkboxes are named "CHK[ColumnHeaderHere]"
With Me.Controls("CHK" & c.Value)
If IsError(m) Then
.Value = False 'clear all if no match
Else
.Value = (UCase(shtData.Cells(m, c.Column)) = "X") 'set if "x"
End If
End With
End If
End Sub
Ranges and Ranges
This is your code squashed a little bit and below is your data:
Private Sub UserForm_Initialize()
Set Year2CourseRange = Sheets("Year2").Range("A:A")
For Each RowYear2 In Year2CourseRange.Cells
If RowYear2.Value = BNumberTxt Then
If RowYear2.Offset(0, 1) = "x" Then
Me.CHKSBB005.value = True
Else: Me.CHKSBB005.value = False: End If
ElseIf IsEmpty(RowYear2) Then
Exit For: End If: Next RowYear2
LoggedInTxt = Row.Offset(0, -3): BNumberTxt = Row.Offset(0, -7)
CourseTxt = Row.Offset(0, -1): CourseNumTxt = Row.Offset(0, -2): End Sub
Take a look for a while, you might see the error yourself.
The CheckBox Tick Mystery
When you write Range("A:A") that refers to the whole column including Range("A1") which appears to be EMPTY. The code never even enters the If RowYear2.Offset... line but exits via the ElseIf line.
The Row Variable
I hate the idea of declaring a variable Row. But it is valid. Since there is an Offset involved, Row should be a range, probably a cell. As in the comments indicated, it has to 'survive' from another UserForm let's say UserFormX. If it has 'survived' you have to refer to it like this:
UserFormX.Row
or you have to declare it in a 'not-object' module to use only Row.
Another EnterBtn_Click
Probably useless now but here is the code I worked on the other day:
Option Explicit
Public intAttempts As Integer
Private Sub CancelBtn_Click()
Unload Me
End Sub
Private Sub EnterBtn_Click()
Const strEmail = "Please enter email address." ' Email Input Message
Const strPassword = "Please enter a password." ' Password Input Message
Const strLoginCorrect = "Welcome" ' Correct Login Message
Const strLoginIncorrect = "Incorrect Login." ' Incorrect Login Message
Const strAttempts = "Too many login attempts." ' Login Attempts Message
' Use worksheet name or index e.g. "SInfo" or 1.
Const vntWsName As String = "StudentInformation" ' Worksheet
' Use column letter or column number e.g. "F" or 6.
Const vntEmailColumn As Variant = "F" ' Email Column
Const intFirstRow As Integer = 2 ' Email Column First Row
Const intPasswordColumnOffset As Integer = -4 ' Password Column Offset
Const intMaxAttempts As Integer = 3 ' Maximum Login Attempts
Dim lngCounter As Long ' Email Column Row Counter
Dim lngLastrow As Long ' Email Column Last Row
' Check number of login attempts.
If intAttempts >= intMaxAttempts Then
MsgBox strAttempts
Exit Sub
End If
' Show annoying text messages if nothing was entered.
If Me.EmailTxt.Text = "" Then
Me.EmailTxt.Text = strEmail: Exit Sub
ElseIf Me.EmailTxt.Text = strEmail Then Exit Sub
End If
If Me.PasswordTxt.Text = "" Then
Me.PasswordTxt.Text = strPassword: Exit Sub
ElseIf Me.PasswordTxt.Text = strPassword Then Exit Sub
End If
' Check for data in specified worksheet.
With ThisWorkbook.Worksheets(vntWsName)
' Determine last row of data in Email Column.
lngLastrow = .Cells(Rows.Count, vntEmailColumn).End(xlUp).Row
For lngCounter = intFirstRow To lngLastrow
' Ceck for email in Email Column.
If UCase(.Cells(lngCounter, vntEmailColumn).Value) _
= UCase(EmailTxt.Text) Then ' Correct email.
' Check if correct password in Password Column
If UCase(.Cells(lngCounter, vntEmailColumn) _
.Offset(0, intPasswordColumnOffset).Value) _
= UCase(PasswordTxt.Text) Then ' Correct password.
Exit For
Else ' Wrong password. Set "counter" to "end".
' Faking that the loop was not interrupted.
lngCounter = lngLastrow
End If
' Else ' Wrong Email. Do nothing. Not necessary.
End If
Next
' When the loop wasn't interrupted, "lngcounter = lnglastrow + 1".
End With
' Check if loop was NOT interrupted.
If lngCounter = lngLastrow + 1 Then ' Loop was NOT interrupted.
intAttempts = intAttempts + 1
MsgBox strLoginIncorrect
Else ' Loop was interrupted. Correct email and password.
MsgBox strLoginCorrect
Unload Me
NewForm.Show
End If
End Sub
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.
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.