I am writing the following code to populate Combobox.
strSQL = "Select BankID, BankName As [Please Select Bank] from tblBank"
With Me.cmbBank
.RowSource = strSQL
.ColumnCount = 2
.BoundColumn = 2
.ColumnWidths = "0in.;1in."
.ColumnHeads = True
.LimitToList = True
.Requery
.Value = "Please Select Bank"
End With
on Button CLick, I am checking combobox selected value and code is here.
MsgBox Me.cmbBank.Value
It shows Text, Is there any way to get Selected Value(BankID)?
Change this to a valid value of BankID:
.Value = "Please Select Bank"
or your combo returns Null which cause the MsgBox to fail, or correct with Nz:
MsgBox Nz(Me!cmbBank.Value, "No bank selected.")
Private Function Validate() As Boolean
If IsNull(Me.cmbBank.Column(0)) = True Then
MsgBox "No bank selected"
Me.cmbBank.SetFocus
Validate = False
Exit Function
End If
Validate = True
End Function
Related
I have a button to lock unlock a form with a subform. To enable the button I would like to set a password with a msgbox. But I have an issue in my code.
I first use the code to show the password msgbox with conditional, if the password is right the user locks/unlocks the forms. But I have end with statement in wrong place.
Private Sub bloquear_Click()
With Me.bloquear
Dim strPasswd
strPasswd = InputBox("Enter Password", "Restricted Form")
If strPasswd = "" Or strPasswd = Empty Then
MsgBox "No Input Provided", vbInformation, "Required Data"
Exit Sub
End If
If strPasswd = "Password" Then
If .Caption = "Unlock" Then
Me.AllowAdditions = True
Me.AllowEdits = True
Me.CONSULTA_PRODUCTOS.Form.AllowAdditions = True
Me.CONSULTA_PRODUCTOS.Form.AllowEdits = True
.Caption = "Lock"
Else
Me.AllowAdditions = False
Me.AllowEdits = False
Me.CONSULTA_PRODUCTOS.Form.AllowAdditions = False
Me.CONSULTA_PRODUCTOS.Form.AllowEdits = False
.Caption = "Unlock"
Me.Refresh
End If
End With
Else
MsgBox "Sorry, you do not have access to this form", _
vbOKOnly, "Important Information"
Exit Sub
End If
End Sub
The msgbox shows
Compile error, end with without with
I don't know what is wrong because the with is there.
Thanks
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've been trying to get my login userform to login when clicked based on data in a table in the workbook, but I just can't seem to get the code right.
Details are:
Userform username textbox = UsernameTextbox;
Userform password textbox = PasswordTextbox;
Userform submit button = LoginButton
My workbook has a number of sheets, one of which is "Users". In that sheet, there is a table called "Users_Table". That table has 4 columns:
ID (individual IDs for users) [Column A],
Username [Column B],
Password [Column C],
Admin (answer is "True" or "False" depending on if they have admin rights) [Column D].
I'm trying to do this:
If the username and password is correct for a user AND if the admin column entry is False, then I want to show sheets "Quick Add" and "Overview", I want to make the sheet "Admin" hidden (not VeryHidden since I need to use data on this sheet for other macros), and make "User" sheets VeryHidden so those logged in can't see other users' details. But for users who correctly enter their username and password AND for whom the admin column entry is True, I want to show all sheets.
This is what I have so far:
Private Sub LoginButton_Click()
Dim Username As String
Username = UsernameTextbox.Text
Dim password As String
Password = PasswordTextbox.Text
If IsNull(Me.UsernameTextbox) Or Me.UsernameTextbox = "" Then
MsgBox "You must enter your username.", vbOKOnly, "Required Data"
Me.UsernameTextbox.SetFocus
Exit Sub
End If
If IsNull(Me.PasswordTextbox) Or Me.PasswordTextbox = "" Then
MsgBox "You must enter your Password (case sensitive).", vbOKOnly, "Incomplete Entry"
Me.PasswordTextbox.SetFocus
Exit Sub
End If
Dim temp As String
On Error Resume Next
temp = WorksheetFunction.VLookup(Me.UsernameTextbox.Value, Worksheets("Users").Range("Users_Table"), 2, 0)
If Username = temp Then
Err.Clear
temp = ""
temp = WorksheetFunction.VLookup(Me.UsernameTextbox.Value, Worksheets("Users").Range("Users_Table"), 3, 0)
On Error Goto 0
If Password = temp Then
Sheets("Quick Add").Visible = xlSheetVisible
Sheets("Overview").Visible = xlSheetVisible
Sheets("Admin").Visible = xlSheetHidden 'This is now just Hidden and not VeryHidden since other macros need to use data on this sheet
Sheets("Users").Visible = xlVeryHidden
MsgBox "Password and Username Accepted. You are now Logged In."
'Unload Me
'Sheets("Quick Add").Select
'Range("A1").Select
Else
Sheets("Quick Add").Visible = xlVeryHidden
Sheets("Overview").Visible = xlVeryHidden
Sheets("Admin").Visible = xlVeryHidden
Sheets("Users").Visible = xlVeryHidden
MsgBox "Username and Password Combination Not Accepted"
End If
Else
Sheets("Quick Add").Visible = xlVeryHidden
Sheets("Overview").Visible = xlVeryHidden
Sheets("Admin").Visible = xlVeryHidden
Sheets("Users").Visible = xlVeryHidden
MsgBox "Invalid Username"
End If
End Sub
This works for the first entry in the "Users_Table", but it won't recognise the Username for the others (and so I don't know if it's recognising the Passwords for users as it's failing on the initial Username check). Any ideas what might be going wrong? I'm also not sure how I'd go about adding in the Admin requirement mentioned above. I need Admins ("True" in "Admin" column, i.e. Column D, in the "Users_Table") to be able to see all sheets; the code above is just for Users and shows "Quick Add" and "Overview" and hides "Admin" and "Users" sheets.
Any help would be much appreciated. Thank you!
Any ideas what might be going wrong?
There are a few errors in the code that don't match your description.
temp = WorksheetFunction.VLookup(Me.UsernameTextbox.Value, _
Worksheets("Users").Range("Users_Table"), 2, 0)
If Username = temp Then
Here you are matching the UsernameTextbox to column A (ID). The test for existence of the username should be in column B not A. The same mistake is made where you are matching the username onto the ID column A insread of the column B of user names:
temp = WorksheetFunction.VLookup(Me.UsernameTextbox.Value, _
Worksheets("Users").Range("Users_Table"), 3, 0)
The best approach would be to fetch to row of the user at once (if it exists) and from there get all the attributes.
Private Sub LoginButton_Click()
' Get the user row or exit if not found
Dim r As Range
Set r = Worksheets("Users").Range("Users_Table").Columns(2) _
.Find(UsernameTextbox.text, , xlValues, xlWhole)
If r Is Nothing Then
MsgBox "username not found."
Me.UsernameTextbox.SetFocus
Exit Sub
End If
If Me.PasswordTextbox.Value <> r.Offset(, 1).Value2 Then
MsgBox "Wrong Password."
Me.PasswordTextbox.SetFocus
Exit Sub
End If
' So far user and password are ok
Dim isAdmin As Boolean: isAdmin = r.Offset(, 2).Value2
Sheets("Quick Add").Visible = xlSheetVisible
Sheets("Overview").Visible = xlSheetVisible
Sheets("Admin").Visible = IIf(isAdmin, xlSheetVisible, xlSheetHidden)
Sheets("Users").Visible = IIf(isAdmin, xlSheetVisible, xlSheetVeryHidden)
End Sub
You have made it very complicated. Keep it simple. Try this (untested)
Private Sub LoginButton_Click()
Dim Username As String
Dim password As String
Dim passWs As Worksheet
Dim rng As Range
Dim CorrectDetails As Boolean
Username = UsernameTextbox.Text
password = PasswordTextbox.Text
If Len(Trim(Username)) = 0 Then
UsernameTextbox.SetFocus
MsgBox "Please enter the username", vbOKOnly, "Required Data"
Exit Sub
End If
If Len(Trim(password)) = 0 Then
PasswordTextbox.SetFocus
MsgBox "Please enter the password", vbOKOnly, "Incomplete Entry"
Exit Sub
End If
Set passWs = ThisWorkbook.Worksheets("Users")
With passWs
lrow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 1 To lrow
If UCase(Trim(.Range("B" & i).Value)) = UCase(Trim(Username)) Then '<~~ Username Check
If .Range("C" & i).Value = password Then '<~~ Password Check
CorrectDetails = True
'~~> Admin is True
If .Range("D" & i).Value = "True" Then
'
'~~> Do what you want
'
Else
'
'~~> Do what you want
'
End If
Exit For
End If
End If
Next i
'~~> Incorrect Username/Password
If CorrectDetails = False Then
MsgBox "Invalid Username/Password"
End If
End With
End Sub
My Assumptions
In sheet "Users", Col B has username, Col C has password and Col D has Admin values.. If not then please amend the above code as required.
Hello everyone,
I know that is was a long time ago, but maybe it would be useful for sm1 the code above did not work for me, so I modify it for my requirements.
Some details of my code:
CommandButton2 it is my "LogIn Button";
TextBox5 it is my "User / Admin name";
TextBox7 it is my "User / Admin password";
Worksheets("LOG") it is a name and location of the table with "User / Admin names and passwords" data, where col B - usernames, col C - user passwords, col d - admin names, col e - admin passwords. The difference between admin and user rights in my case only in visibility of application (Excel).
Private Sub CommandButton2_Click()
Dim passWs As Worksheet
Dim CorrectDetails As Boolean
Username = TextBox5.Text
password = TextBox7.Text
If Len(Trim(Username)) = 0 Then
TextBox5.SetFocus
MsgBox "Please enter the username", vbOKOnly, "Required Data"
Exit Sub
End If
If Len(Trim(password)) = 0 Then
TextBox7.SetFocus
MsgBox "Please enter the password", vbOKOnly, "Incomplete Entry"
Exit Sub
End If
Set passWs = ThisWorkbook.Worksheets("LOG")
With passWs
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = 1 To lRow
If UCase(Trim(.Range("B" & i).value)) = UCase(Trim(Username)) Then '<~~ Username Check
If .Range("C" & i).value = password Then '<~~ Password Check
CorrectDetails = True
If CorrectDetails = True Then
Application.Visible = False
Me.TextBox5.Text = ""
Me.TextBox7.Text = ""
LogIn.Hide
UserForm1.Show
End If
Exit For
End If
End If
If UCase(Trim(.Range("D" & i).value)) = UCase(Trim(Username)) Then '<~~ Adminname Check
If .Range("E" & i).value = password Then '<~~ Admin Password Check
CorrectDetails = True
If CorrectDetails = True Then
Application.Visible = True
Me.TextBox5.Text = ""
Me.TextBox7.Text = ""
LogIn.Hide
End If
Exit For
End If
End If
Next i
'~~> Incorrect Username/Password
If CorrectDetails = False Then
MsgBox "Invalid Username/Password"
End If
End With
End Sub
I have the following code to customize the right click menu:
Sub CreateMenuItem()
Dim MenuButton As CommandBarButton
With CommandBars("Text") 'Text, Lists and Tables
Set MenuButton = .Controls.Add(msoControlButton)
With MenuButton
.Caption = "Correct"
.Style = msoButtonCaption
.OnAction = "InsertCorrect"
End With
End With
End Sub
It works fine with text and lists, but only partially with tables:
With CommandBars("Tables")
I must select the whole table or a column then it works but not inside a cell. What is the name for the context menu inside a cell or for text inside a table cell?
I made this routine to see al the names of the CommandBars in Word:
Sub ListYourCommandBars()
For Each c In CommandBars
Debug.Print c.Name
Next
End Sub
Good news they are already sorted alphabetically. I found one called Table Cells. I tried it:
With CommandBars("Table Cells")
and it worked. Only thing, a cell or a number of cells must be "wholly selected". That is, the menu-item doesnt show up if you just enter inside the cell, you must select the cell "as a whole" (dunno how to say it better). Hope this helps.
I got it to work inside a table cell by adding the MenuButton to the following Built-In CommandBars: "Text", "Linked Text", "Table Text", "Font Paragraph", "Linked Headings", "Linked Table", "Linked Text", "Lists", "Table Cells", "Table Lists", "Tables", "Tables and Borders", and "Text Box".
I’m not sure which one actually did the trick. Here’s my code:
Private DisableEvents As Boolean
Private Sub UpdateRightClickMenus()
Dim MenuButton As CommandBarButton
Dim CommandBarTypes(100) As String
Dim i As Long
Dim PRChecklistIsSelected As Boolean
Dim CheckListTypeFound As Boolean
PRChecklist = True
ResetRightClickMenus
CommandBarTypes(0) = "Text"
CommandBarTypes(1) = "Linked Text"
CommandBarTypes(2) = "Table Text"
CommandBarTypes(3) = "Font Paragraph"
CommandBarTypes(4) = "Linked Headings"
CommandBarTypes(5) = "Linked Table"
CommandBarTypes(6) = "Linked Text"
CommandBarTypes(7) = "Lists"
CommandBarTypes(8) = "Table Cells"
CommandBarTypes(9) = "Table Lists"
CommandBarTypes(10) = "Tables"
CommandBarTypes(11) = "Tables and Borders"
CommandBarTypes(12) = "Text Box"
Dim cc As ContentControl
Set cc = FindContentControlByTag("ListBox_PR_TR")
If IsNull(cc) Then
DisableEvents = False
Exit Sub
End If
'Find Selected
For i = 1 To cc.DropdownListEntries.Count
If cc.Range.Text = "Product Review" Then
PRChecklistIsSelected = True
CheckListTypeFound = True
Exit For
End If
If cc.Range.Text = "Technical Review" Then
PRChecklistIsSelected = False
CheckListTypeFound = True
Exit For
End If
Next i
If CheckListTypeFound = False Then Exit Sub
For i = 0 To 12
With Application
If PRChecklistIsSelected Then
'Add right-click menu option to set as a Product Review comment
With .CommandBars(CommandBarTypes(i))
Set MenuButton = .Controls.Add(msoControlButton)
With MenuButton
.Caption = "Set as Product Review Comment"
.Style = msoButtonCaption
.OnAction = "Set_as_Product_Review_Comment"
End With
End With
Else
'Add right-click menu option to set as a Tech Review comment
With .CommandBars(CommandBarTypes(i))
Set MenuButton = .Controls.Add(msoControlButton)
With MenuButton
.Caption = "Set as Tech Review Comment"
.Style = msoButtonCaption
.OnAction = "Set_as_Tech_Review_Comment"
End With
End With
End If
End With
Next i
RightClickMenuItemsAdded = True
End Sub
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
If DisableEvents = True Then Exit Sub
Set cc = FindContentControlByTag("ListBox_PR_TR")
If IsNull(cc) Then
ResetRightClickMenus
DisableEvents = False
Exit Sub
End If
If cc.Range.Text = "Technical Review" Then
Find_PR_Style_ReplaceWith_TR_Style
End If
UpdateRightClickMenus
DisableEvents = False
End Sub
Private Sub Find_PR_Style_ReplaceWith_TR_Style()
Set StylePR = ThisDocument.Styles("Product Review Style")
Set StyleTR = ThisDocument.Styles("Technical Review Style")
With ThisDocument.Content.Find
.ClearFormatting
.Style = StylePR
With .Replacement
.ClearFormatting
.Style = StyleTR
End With
.Execute Forward:=True, Replace:=wdReplaceAll, FindText:="", ReplaceWith:=""
End With
End Sub
Private Sub Set_as_Tech_Review_Comment()
Set StyleTR = ThisDocument.Styles("Technical Review Style")
With ThisDocument
Selection.Style = StyleTR
SetCanContinuePreviousList
End With
End Sub
Private Sub Set_as_Product_Review_Comment()
Set StylePR = ThisDocument.Styles("Product Review Style")
With ThisDocument
Selection.Style = StylePR
SetCanContinuePreviousList
End With
End Sub
Private Sub SetCanContinuePreviousList()
Dim lfTemp As ListFormat
Dim intContinue As Integer
Dim oldListNumber As Single
Set lfTemp = Selection.Range.ListFormat
oldListNumber = lfTemp.ListValue
If Not (lfTemp.ListTemplate Is Nothing) Then
intContinue = lfTemp.CanContinuePreviousList( _
ListTemplate:=lfTemp.ListTemplate)
lfTemp.ApplyListTemplate _
ListTemplate:=lfTemp.ListTemplate, _
ContinuePreviousList:=False, _
ApplyTo:=wdListApplyToWholeList
If lfTemp.ListValue = oldListNumber Then
lfTemp.ApplyListTemplate _
ListTemplate:=lfTemp.ListTemplate, _
ContinuePreviousList:=True, _
ApplyTo:=wdListApplyToWholeList
End If
End If
Set lfTemp = Nothing
End Sub
Private Function FindContentControlByTag(Tag As String) As ContentControl
For Each cc In ThisDocument.ContentControls
If cc.Tag = Tag Then
Set FindContentControlByTag = cc
Exit Function
End If
Next
End Function
Private Sub ResetRightClickMenus()
Dim CommandBarTypes(100) As String
Dim i As Long
CommandBarTypes(0) = "Text"
CommandBarTypes(1) = "Linked Text"
CommandBarTypes(2) = "Table Text"
CommandBarTypes(3) = "Font Paragraph"
CommandBarTypes(4) = "Linked Headings"
CommandBarTypes(5) = "Linked Table"
CommandBarTypes(6) = "Linked Text"
CommandBarTypes(7) = "Lists"
CommandBarTypes(8) = "Table Cells"
CommandBarTypes(9) = "Table Lists"
CommandBarTypes(10) = "Tables"
CommandBarTypes(11) = "Tables and Borders"
CommandBarTypes(12) = "Text Box"
For i = 0 To 12
Application.CommandBars(CommandBarTypes(i)).Reset
Next i
RightClickMenuItemsAdded = False
End Sub
Private Sub Document_Open()
UpdateRightClickMenus
End Sub
Private Sub Document_Close()
ResetRightClickMenus
End Sub
I have 6 CheckBoxes right now under an Audience category and want to make it so that they have to select at least 1 of the 6 CheckBoxes or an error message saying "Please select an Audience" will appear.
Right now with the code below, the project will still be entered regardless of if they check one of the 6 boxes or not.
My current code looks like:
Function CheckInputs() As Boolean
If Not CheckControl(Me.nameTextbox, "Please enter your name") Then Exit Function
If Not CheckControl(Me.projectTextbox, "Please enter a Project Name") Then Exit Function
If Not CheckControl(Me.initiativeCombobox, "Please select an Initiative") Then Exit Function
If Not CheckControl(Me.impactCombobox, "Please select Impact Type") Then Exit Function
If Not CheckControl(Me.lengthListbox, "") Then If Not CheckControl(Me.lengthListbox2, "Please enter project length") Then Exit Function
If Not CheckControl(Me.rvpCheckbox, "") Then If Not CheckControl(Me.umCheckbox, "") Then If Not CheckControl(Me.uwCheckbox, "") Then If Not CheckControl(Me.baCheckbox, "") Then If Not CheckControl(Me.uaCheckbox, "") Then If Not CheckControl(Me.otherCheckbox, "Please select an Audience") Then Exit Function
CheckInputs = True
End Function
Private Function CountSelectedListBoxItems(lb As MSForms.ListBox) As Long
Dim i As Long
With lb
For i = 0 To .ListCount - 1
If .Selected(i) Then CountSelectedListBoxItems = CountSelectedListBoxItems + 1
Next i
End With
End Function
Function CheckControl(ctrl As MSForms.Control, errMsg As String) As Boolean
Select Case TypeName(ctrl)
Case "TextBox"
CheckControl = Trim(ctrl.Value) <> ""
Case "ComboBox"
CheckControl = ctrl.ListIndex <> -1
Case "ListBox"
CheckControl = CountSelectedListBoxItems(ctrl) > 0
Case "CheckBox"
CheckControl = ctrl.Value = False
' Case Else
End Select
If errMsg = "" Then Exit Function
If CheckControl Then Exit Function
ctrl.SetFocus
MsgBox errMsg
End Function
Would setting a CheckControl function for CheckBox as ctrl.Value = False be the appropriate route? Or did I not set my CheckInputs function correctly?
Yes, it seems to me that (if I understand correctly) your CheckInputs function is currently incorrect.
The following line of code:
If Not CheckControl(Me.rvpCheckbox, "") Then If Not CheckControl(Me.umCheckbox, "") Then If Not CheckControl(Me.uwCheckbox, "") Then If Not CheckControl(Me.baCheckbox, "") Then If Not CheckControl(Me.uaCheckbox, "") Then If Not CheckControl(Me.otherCheckbox, "Please select an Audience") Then Exit Function
needs to be change to the following:
If UserForm1.rvpCheckbox.Value = False And _
UserForm1.umCheckbox.Value = False And _
UserForm1.uwCheckbox.Value = False And _
UserForm1.baCheckbox.Value = False And _
UserForm1.uaCheckbox.Value = False And _
UserForm1.otherCheckbox.Value = False Then
UserForm1.otherCheckbox.Caption = "Please select an Audience"
'...or maybe a message box instead?
MsgBox "Please select an Audience"
Exit Function
End If