The following is my VB code. I want to count all the distinct records about "Peter" in a spreadsheet without duplication.
When I run the code, "Run-time error '13':Type Mismatch" always appear. I fail to debug. What's wrong with my code?
Private Sub CheckBox5_Click()
Dim myarray As Variant
myarray = WorksheetFunction.If(Range("C7:C266") = "Peter", 1 / (WorksheetFunction.CountIfs(Range("C7:C266"), "Peter", Range("F7:F266"), Range("F7:F266"))), 0)
If CheckBox5.Value = True Then
TextBox6.Value = WorksheetFunction.Sum(myarray) + 1
End If
If CheckBox5.Value = False Then
TextBox6.Value = ""
End If
End Sub
The error you are getting is a result of the way the IF function is called. The first term must be a logical result, but you cannot call the value of a multi-cell Range (ie Range("C7:C266")). To solve this problem, I think you will need to loop through each of the cells and act on them accordingly, although there may be a more clever solution using something other than IF that I am not aware of
You can do it like this:
Sub findPeter()
Dim ws As Worksheet
Dim peterCount As Long
Set ws = Worksheets("nameofyoursheet")
With ws
For i = 7 To 266
If .Cells(i, 3) = "Peter" Then
peterCount = peterCount + 1
End If
Next
End With
If CheckBox5.Value = True Then
TextBox6.Value = peterCount + 1
End If
If CheckBox5.Value = False Then
TextBox6.Value = ""
End If
End Sub
peterCount is the sum of all occurences of the value Peter.
Related
Good Day People,
im kinda new to VBA.
Im trying to make a time and attandance.
Im actually pretty far, but unforntuanly i ran into a problem.
I use 2 Userforms. One where you get with your id to your sheet and can then clock in or clock out on the userform2.
When they clocked in or clocked it, it goes back to the first form. Unfornuatly the form doesnt work then anymore. I tried loading, hide, show, exit sub, searched the internet but cant find a solution.
Maybe im doing something wrong, that the modul / Userform doesnt work anymore.
Im thankfull for any help.
Dont mind Names of Strings and stuff, its just a test before i do the real one.
Im using the modulobject for the code. Looks better for me
So im refering in Userform1 Objects to a sub in the modullib.
Modul1:
Function DoesSheetExists(sh As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(sh)
On Error GoTo 0
If Not ws Is Nothing Then DoesSheetExists = True
End Function
Sub ScanID()
Dim MitarbeiterWS As Worksheet
Dim MitarbeiterID As Range
Dim MitarbeiterIDstring As String
Dim MitarbeiterName As String
ThisWorkbook.Sheets("MitarbeiterID").Activate
MitarbeiterIDstring = UserForm1.TextBox1.Value
Set MitarbeiterID = Range("A1:A30").Find(What:=MitarbeiterIDstring)
If Not MitarbeiterID Is Nothing Then
MitarbeiterName = MitarbeiterID.Offset(, 1).Value
UserForm1.Label1 = MitarbeiterName
If Not DoesSheetExists(MitarbeiterName) Then
If Not MitarbeiterName = "" Then
Sheets("Example").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = MitarbeiterName
Unload UserForm1
UserForm2.Show
MitarbeiterID.Select
Else
End If
Else
ThisWorkbook.Sheets(MitarbeiterName).Activate
Unload UserForm1
UserForm2.Show
End If
Else
End If
End Sub
Modul2
Sub Eincloggen()
Dim Einspalte As Range
Set Einspalte = Range("A1").End(xlDown)
'wenn zum ersten mal eingeclockt
If Einspalte.Offset(, 1).Value = "" Then
If Einspalte.Value = "Clocked In" Then
Einspalte.Offset(1, 0).Value = Now
Else
MsgBox "Erst Raus"
End If
Else
Einspalte.Offset(1, 0).Value = Now
Unload UserForm2
UserForm2.Hide
UserForm1.Show
End If
End Sub
Sub Auscloggen()
Dim Einspalte As Range
Dim Ausspalte As Range
Dim Pausenspalte As Range
Dim Stundenspalte As Range
Set Einspalte = Range("A1").End(xlDown)
Set Ausspalte = Range("B1").End(xlDown)
Set Pausenspalte = Range("C1").End(xlDown)
Set Stundenspalte = Range("D1").End(xlDown)
If Ausspalte.Offset(1, -1).Value = "" Then
MsgBox "Erst Rein"
Else
Ausspalte.Offset(1, 0).Value = Now
If Not Ausspalte.Offset(1, 0).Value = "" Then
Stundenspalte.Offset(1, 0).Value = (Ausspalte.Offset(1, 0).Value) - (Einspalte.Value)
Stundenspalte.Offset(1, 0).NumberFormat = "hh:mm"
Unload UserForm2
UserForm2.Hide
UserForm1.Show
End If
End If
End Sub
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
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'm new at VBA coding and working on a match code. The code is working just fine when I run the code in "Data sheet" (the sheet were all my data is and were the match has to be found), but when i'm run the code on the frontpage (Sheet 1 with userforms) the code is debuggen and says "Runtime Error 13". Can anybody tell what the problem is?
And can anybody tell me why my "If isError" doesn't work?
Thanks in advance!
Br
'Find SKU and Test number
Dim icol As Integer
Sheet13.Range("XFD2") = UserForm2.ComboBox1.Value 'Sættes = ComboBox1.value
Sheet13.Range("XFD3") = UserForm2.ComboBox2.Value 'Sættes = ComboBox2.value
icol = [Sheet13.MATCH(XFD2&XFD3,A:A&Q:Q,0)] 'Match af værdien for vores SKU og test nr
With ThisWorkbook.Worksheets("Data sheet")
'If SKU or Test number not found, then messagebox
If IsError("A:A") Then MsgBox "SKU not found": Exit Sub
If IsError("Q:Q") Then MsgBox "Test number not found": Exit Sub
'Add test result/next step and comment
.Cells(icol, 30).Value = Me.ComboBox3.Value
.Cells(icol, 30 + 1).Value = Me.Comments_To_Result.Value
End With
End If
Set objFSO = Nothing
Set openDialog = Nothing
Range("XFD2").Clear
Range("XFD3").Clear
icol should be like this:
icol = Application.match(arg1, arg2, arg3)
See the samples in MSDN:
var = Application.Match(Cells(iRow, 1).Value, Worksheets(iSheet).Columns(1), 0)
Concerning If IsError("A:A") Then MsgBox "SKU not found": Exit Sub, you are doing it wrongly. I assume, that you want to loop through all the cells in the first column and to get whether one of them is an error. You need a loop for this. This is a really simple one, but you should implement it somehow in your code:
Option Explicit
Public Sub TestMe()
Dim rng As Range
For Each rng In Range("A:A")
If IsError(rng) Then Debug.Print rng.Address
Next rng
End Sub
I'm having a problem populating a userform. I found some code online that does exactly what I want and the 'example' file works perfectly. When I modify it to my needs, it gives me an error message on the following line:
frmModifyData.Skill.Value = Application.VLookup(cmbItemName.Value, Sheets("Enrolled").Range(vrange), 1, False)
Here's the entire code I'm working with:
Dim NotNow As Boolean
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOkay_Click()
NotNow = True
N = Application.Match(Me.cmbItemName.Value, Range("AB:AB"), 0)
Cells(N, 1).Value = Me.frmEnterData.Skill.Text
Cells(N, 2).Value = Me.frmEnterData.txtCLASS.Text
Cells(N, 3).Value = Me.frmEnterData.LastName.Text
NotNow = False
End Sub
Private Sub cmbItemName_Change()
If NotNow Then Exit Sub
vrange = "FirstField"
'LINE WITH THE PROBLEM
frmModifyData.Skill.Value = Application.VLookup(cmbItemName.Value, Sheets("Enrolled").Range(vrange), 1, False)
'END OF LINE WITH THE PROBLEM (though it could affect the two lines of code below...)
frmModifyData.txtCLASS.Value = Application.VLookup(cmbItemName.Value, Sheets("Enrolled").Range(vrange), 2, False)
frmModifyData.LastName.Value = Application.VLookup(cmbItemName.Value, Sheets("Enrolled").Range(vrange), 3, False)
End Sub
Private Sub UserForm_Initialize()
frmModifyData.cmbItemName.RowSource = "FirstField"
End Sub
'FirstField' is a named range that is defined this way
=OFFSET(Enrolled!$AB$3,0,0,COUNTA(Enrolled!$AB:$AB)-1,3)
Column AB holds the "Full Name" of the user. This is what I'm using to find an individual. Once I pick a name using a drop-down box on the userform, it gives me the message Could not set the Value property. Invalid property value.
How do I fix this so it works?
Try breaking your code down a little and make sure your vlookup is working...
Dim v
v = Application.VLookup(cmbItemName.Value, Sheets("Enrolled").Range(vrange), 1, False)
If Not IsError(v) Then
frmModifyData.Skill.Value = v
Else
Msgbox cmbItemName.Value & " was not found!"
End If