Why when I double click at list box, the data will come out the previous one? And sometimes, it just comes out the random data from the list box.
FYI, it will happen on "Amount to be Collected (Emp 4)", "Acct. Mgr(Emp 5)", "Phone (Emp 6)" and "Email (Emp 7)".
Here is the image so that you can see clearer.
Private Sub lstEmployee_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'dim the variables
Dim i As Integer
On Error Resume Next
'find the selected list item
i = Me.lstEmployee.ListIndex
Dim methodsOfCommunication() As String
Me.Emp1.Value = Me.lstEmployee.Column(0, i)
Select Case Me.lstEmployee.Column(2, i)
Case "Yes"
Me.Emp2.Value = True
Me.Emp3.Value = False
Case "No"
Me.Emp2.Value = False
Me.Emp3.Value = True
End Select
' Reset Methods of Communication checkboxes.
Me.Emp8.Value = False
Me.Emp9.Value = False
Me.Emp10.Value = False
Me.Emp11.Value = False
Me.Emp12.Value = False
' Set Methods of Communication checkboxes.
methodsOfCommunication = Split(Me.lstEmployee.Column(1, i), ", ")
For i = LBound(methodsOfCommunication, 1) To UBound(methodsOfCommunication, 1)
Select Case methodsOfCommunication(i)
Case "Whatsapp"
Me.Emp8.Value = True
Case "Phone Call"
Me.Emp9.Value = True
Case "Facebook"
Me.Emp10.Value = True
Case "Email"
Me.Emp11.Value = True
Case "SMS"
Me.Emp12.Value = True
End Select
Next
Me.Emp4.Value = Me.lstEmployee.Column(3, i)
Me.Emp5.Value = Me.lstEmployee.Column(4, i)
Me.Emp6.Value = Me.lstEmployee.Column(5, i)
Me.Emp7.Value = Me.lstEmployee.Column(6, i)
Me.Emp13.Value = Me.lstEmployee.Column(7, i)
Me.Emp14.Value = Me.lstEmployee.Column(8, i)
Me.Emp15.Value = Me.lstEmployee.Column(9, i)
On Error GoTo 0
End Sub
Related
Below code pulls the values from 10 checkboxes and applies a respective Boolean check.
I'm struggling with concatenating the checkbox and Boolean names into a While loop. Anyone assist please?
If CheckD1.Value = True Then check1 = True
If CheckD2.Value = True Then check2 = True
If CheckD3.Value = True Then check3 = True
If CheckD4.Value = True Then check4 = True
If CheckD5.Value = True Then check5 = True
If CheckD6.Value = True Then check6 = True
If CheckD7.Value = True Then check7 = True
If CheckD8.Value = True Then check8 = True
If CheckD9.Value = True Then check9 = True
If CheckD10.Value = True Then check10 = True
You need to use an array Check(1 To 10) instead of individual variables check1 … check10 and something like UserForm1.Controls to access your checkboxes by a variable name:
Dim Check(1 To 10) As Boolean
Dim i As Long
For i = 1 To 10
Check(i) = UserForm1.Controls("CheckD" & i).Value
Next i
UserForm1 is the form your checkboxes CheckD1 to CheckD10 are in.
If you used Form Controls on a worksheet then it should be
Check(i) = (ThisWorkbook.Worksheets("Sheet1").Shapes("CheckD" & i).OLEFormat.Object.Value = 1)
Worked it out myself in the end, so posting the answer for others if they need.
Declared my check Booleans as an array with:
Dim check(1 to 10) as Boolean
Then looped through the checkboxes on the UserForm with:
For i = 1 To 10
If Me.Controls("CheckD" & i).Value = True Then
check(i) = True
End If
Next I
Simple for those that know, but something new learnt for today!
via the below code I have a number of validation steps. Currently if a user omits 1 or more data inputs and or inputs incorrectly data they are getting multiple msgboxes. Not a great UI experience, what I'm looking to do is to concatenate these strings into a single msgbox. Bear in mind I'm unable to do so using System.Text etc to generate a string builder using append.
I'm relatively new to vba so if you do post any comments or feedback if you could explain it as fully as possible.
Public Function ValidateMe(strAccNum As String, iDte As Integer, strTRS As String, strPrem As String) As Boolean
' Function tests each input passed to it and validates it. If there is an issue the user is notified with a message box.
Dim blnValAcc As Boolean
Dim blnValDte As Boolean
Dim blValTRS As Boolean
Dim blnValPrem As Boolean
Dim blnValidOverall As Boolean
' Default to Invalid
blnValAcc = False
blnValDte = False
blnValTRS = False
blnValPrem = False
blnValidOverall = False
' Validate Account Number
Dim strMessage As String
Dim strSortCode As String
strMessage = ""
strSortCode = Left(strAccNum, 6)
' AccNum must be 14 characters long and all characters must be numeric
If (Len(strAccNum) = 14 And (IsNumeric(strAccNum) = True)) Then
blnValAcc = True
Else:
strMessage = strMessage & vbNewLine & "Account Number must be 14 characters long and contain only numeric characters."
End If
' 8 and 10 digit account nubmers cannot have a due date change
If (Len(strAccNum) = (8 Or 10) And (IsNumeric(strAccNum) = True)) Then
blnValAcc = False
strMessage = strMessage & vbNewLine & "8 and 10 digit account numbers cannot have a due date change."
End If
' Checks sort code against list of sort codes if the accout number has already passed previous tests
If blnValAcc = True Then
blnValAcc = CheckSortCode(strSortCode)
If blnValAcc = False Then
strMessage = strMessage & "Check sort code."
End If
End If
If blnValAcc = False Then
MsgBox strMessage, , "Check Account Number"
End If
' Validate new Due Date
If (iDte >= 1 And iDate <= 31) Then
blnValDte = True
Else:
blnValDte = False
MsgBox "Please enter a valid due date, a number between 1 and 31", , "Invalid Date"
End If
If ((strTRS = "Yes") Or (strTRS = "No")) Then
blnValTRS = True
End If
' Validate strPrem
If strPrem = "Yes" Then
blnValPrem = True
Else:
MsgBox "Customer must be advised of how change may affect premiums.", , "Premium Changes"
End If
' Validate strTRS
If strTRS = "" Then
valTRS = False
MsgBox "Please select an option from the drop down menu.", , "Customer has been advised of TRS implications?"
End If
If ((blnValAcc = True) And (blnValDte = True) And (blnValTRS = True) And (blnValPrem = True)) Then
blnValidOverall = True
End If
' Function returns true or false
ValidateMe = blnValidOverall
End Function
Basic pattern:
Dim msg as string
If someProblem1 then
msg = msg & iif(len(msg) > 0, vbLf, "") & "Problem1 description"
end if
if someProblem2 then
msg = msg & iif(len(msg) > 0, vbLf, "") & "Problem2 description"
end if
'etc etc
'done testing...
if len(msg) > 0 then
msgbox "There are some problems with your submission:" & vbLf & vbLf & msg,, "Oops"
end if
ValidateMe = (Len(msg) = 0)
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
May I know, how to make the option box and checkbox checked as in the list box? Let say, if the data is yes so that the option box will automatically be checked and another one if the choose Whatsapp and email it will automatically be checked at the WhatsApp and email.
The column from Method is starting from column C9 and for Participation at column D9.
FYI,
Emp 2 - Yes Emp 3 - No Emp 8 - Whatsapp Emp 9 - Phone Call Emp 10 -
Facebook Emp 11 -Email Emp 12 - SMS
And here is the coding that I already try
Private Sub lstEmployee_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'dim the variables
Dim i As Integer
On Error Resume Next
'find the selected list item
i = Me.lstEmployee.ListIndex
'add the values to the text boxes
Dim methodsOfCommunication() As String
Me.Emp1.Value = Me.lstEmployee.Column(0, i)
Select Case Me.lstEmployee.Column(2, i)
Case "Yes"
Emp2.Value = True
Emp3.Value = False
Case "No"
Emp2.Value = False
Emp3.Value = True
End Select
' Reset Methods of Communication checkboxes.
Emp8.Value = False
Emp9.Value = False
Emp10.Value = False
Emp11.Value = False
Emp12.Value = False
' Set Methods of Communication checkboxes.
methodsOfCommunication = Split(Me.lstEmployee.Column(1, i), ", ")
For i = LBound(methodsOfCommunication, 1) To UBound(methodsOfCommunication, 1)
Select Case methodsOfCommunication(i)
Case "Whatsapp"
Emp8.Value = True
Case "Phone Call"
Emp9.Value = True
Case "Facebook"
Emp10.Value = True
Case "Email"
Emp11.Value = True
Case "SMS"
Emp12.Value = True
End Select
Next
Me.Emp4.Value = Me.lstEmployee.Column(3, i)
Me.Emp5.Value = Me.lstEmployee.Column(4, i)
Me.Emp6.Value = Me.lstEmployee.Column(5, i)
Me.Emp7.Value = Me.lstEmployee.Column(6, i)
Me.Emp13.Value = Me.lstEmployee.Column(7, i)
Me.Emp14.Value = Me.lstEmployee.Column(8, i)
Me.Emp15.Value = Me.lstEmployee.Column(9, i)
On Error GoTo 0
End Sub
Dim methodsOfCommunication() As String
Dim i As Integer
Me.Emp1.Value = Me.lstEmployee.Column(0, i)
Select Case Me.lstEmployee.Column(2, i)
Case "Yes"
Me.Emp2.Value = True
Me.Emp3.Value = False
Case "No"
Me.Emp2.Value = False
Me.Emp3.Value = True
End Select
' Reset Methods of Communication checkboxes.
Me.Emp8.Value = False
Me.Emp9.Value = False
Me.Emp10.Value = False
Me.Emp11.Value = False
Me.Emp12.Value = False
' Set Methods of Communication checkboxes.
methodsOfCommunication = Split(Me.lstEmployee.Column(1, i), ", ")
For i = LBound(methodsOfCommunication, 1) To UBound(methodsOfCommunication, 1)
Select Case methodsOfCommunication(i)
Case "Whatsapp"
Me.Emp8.Value = True
Case "Phone Call"
Me.Emp9.Value = True
Case "Facebook"
Me.Emp10.Value = True
Case "Email"
Me.Emp11.Value = True
Case "SMS"
Me.Emp12.Value = True
End Select
Next
I'm developing a userform, one section of which contains three checkboxes referring to different parts of the world. Depending on the combination these enter a text value into cell C9.
I want to have the checkboxes reflect what is in the cell already when the user goes back into the userform. I've been able to do this for every other item in the userform (option buttons, textboxes, comboboxes), but my checkboxes don't respond at all, they are simply unchecked when the userform appears, regardless of C9's value.
The following code is in the userform_intialize module. Any ideas?
If wsM.Range("C9").Value = "EU-5" Then
NABox.Value = False And EUBox.Value = True And RoWBox.Value = False
ElseIf wsM.Range("C9").Value = "EU-5 & RoW" Then
NABox.Value = False And EUBox.Value = True And RoWBox.Value = True
ElseIf Sheets("Menu").Range("C9").Value = "NA & EU-5" Then
NABox.Value = True And EUBox.Value = True And RoWBox.Value = False
ElseIf wsM.Range("C9").Value = "North America" Then
NABox.Value = True And EUBox.Value = False And RoWBox.Value = False
ElseIf wsM.Range("C9").Value = "NA & RoW" Then
NABox.Value = True And EUBox.Value = False And RoWBox.Value = True
ElseIf wsM.Range("C9").Value = "Rest of World" Then
NABox.Value = False And EUBox.Value = False And RoWBox.Value = True
Else: NABox.Value = False And EUBox.Value = False And RoWBox.Value = False
End If
Thanks for any help.
Put the Me. keyword in front of the checkbox name.
May also be better to use a SELECT CASE statement instead of ElseIf.
NABox.Value = False And EUBox.Value = True And RoWBox.Value = False needs to be three separate commands. Either on separate rows, or split with a : (both examples in the code below).
Private Sub UserForm_Initialize()
With Me
Select Case wsm.Range("C9").Value
Case "EU-5"
NABox.Value = False
EUBox.Value = True
RoWBox.Value = False
Case "EU-5 & RoW"
NABox.Value = False : EUBox.Value = True
RoWBox.Value = False
Case "NA & EU-5"
Case Else
End Select
End With
End Sub
Edit - I don't think you need to explicitly declare the False tickboxes - they're False by default when the form opens.