Error with VBA code

[hsolanki]

Hi can anybody fix me this formula which is for the User form

Sub Addme()

'declare the variables
Dim Addme As Range
Dim x As Integer
'error handler
On Error GoTo errHandler:
'find the next black row in the database
Sheet1.Unprotect Password:="Bhaji2019"
With Sheet1.Range("c710000") ' Simply Change the range to suit
.Locked = False
.FormulaHidden = False
If Application.WorksheetFunction.CountIf(Sheet1.Range("G:G").Me.cboBooked) > 0 Then
MsgBox "on a Job"
Me.cboBooked.Value = ""
Exit Sub
Else: Addme

End If
End With
Set Addme = Sheet1.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
'loop through multi selected items and add them to the database
For x = 0 To Me.lstSelector.ListCount - 1
If Me.lstSelector.Selected(x) Then

Addme = Me.cbodatetime
Addme.Offset(0, 1) = Me.lstSelector.List(x)
Addme.Offset(0, 2) = Me.cboBooked.Value
Addme.Offset(0, 3) = Me.txtJob.Value
Addme.Offset(0, 4) = Me.lstSelector.List(x, 3)
Addme.Offset(0, 5) = Me.lstSelector.List(x, 4)
Addme.Offset(0, 6) = Me.lstSelector.List(x, 5)
Addme.Offset(0, 7) = Me.lstSelector.List(x, 6)
Addme.Offset(0, 8) = Me.lstSelector.List(x, 7)
Addme.Offset(0, 9) = Me.lstSelector.List(x, 8)
Set Addme = Addme.Offset(1, 0)
End If
Next x
'error block
On Error GoTo 0
Exit Sub
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please Contact Harin Solanki"

End Sub

 

[hsolanki]

Hi Sorry

on Sheet 1 column (G) and control (txtjob) in Job Number or Run (CMDBook) control

 

[FormR]

or Run (CMDBook) control

I don't know what this means?

on Sheet 1 column (G) and control (txtjob) in Job Number

Are you saying column G needs to equal control txtjob? No other criteria?

Column G on the sample workbook is labelled as "Staff ID" and txtjob is labelled as "Job Number" - this doesn't sound right?

 

[hsolanki]

Colum G is the Staff ID which always be different number therefore it will be easy to find duplicate in the sheet 1 as with names two different people can have the same name.

it was just an suggestion and reason for txtbox i said is because if there was Duplicate found then you wont be able to enter Job number

CMDBook is the actual command button which is refreshing and transferring data on to Sheet1 from user form.

i know this sound so complicating

 

[FormR]

I'm just going to take a guess.

Try replacing your current "check for duplicates" with this.

    'check for duplicate payroll numbers
If WorksheetFunction.CountIfs(Sheet2.Range("G:G"), Me.reg4.Value, Sheet2.Range("F:F"), Me.txtJob) > 0 Then
   MsgBox "This staff member already exists"
   Exit Sub
End If

Which says if the value in "reg4" (which is labelled as "Staff ID") in in column G AND the value in "txtJob" (labelled as "Job Number") is in column F then display the msgbox and don't add the job.

If this isn't what you want, then you need to try to find a way to describe what you do want in a clear and concise way.

 

[hsolanki]

Hi there Yes something similar to find duplicates on Sheet 1 when you are allocating them a Job.

above code will find a duplicate when yo adding new member of staff on to the staff lift on sheet 2.

however i want to find if there's a duplicate already on sheet 1 when allocating them a Job, i have tried above code changing it to Sheet 1 by placing the code either below but it did not worked.

Sub Addme()

'declare the variables
Dim Addme As Range
Dim x As Integer
'error handler
On Error GoTo errHandler:
'find the next black row in the database
Sheet1.Unprotect Password:="Bhaji2019"
With Sheet1.Range("c710000") ' Simply Change the range to suit
.Locked = False
.FormulaHidden = False
If WorksheetFunction.CountIfs(Sheet1.Range("G:G"), Me.reg4.Value, Sheet1.Range("F:F"), Me.txtJob) > 0 Then
MsgBox "This staff member already exists"
Exit Sub
End If


End If
End With
Set Addme = Sheet1.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
'loop through multi selected items and add them to the database
For x = 0 To Me.lstSelector.ListCount - 1
If Me.lstSelector.Selected(x) Then

Addme = Me.cbodatetime
Addme.Offset(0, 1) = Me.lstSelector.List(x)
Addme.Offset(0, 2) = Me.cboBooked.Value
Addme.Offset(0, 3) = Me.txtJob.Value
Addme.Offset(0, 4) = Me.lstSelector.List(x, 3)
Addme.Offset(0, 5) = Me.lstSelector.List(x, 4)
Addme.Offset(0, 6) = Me.lstSelector.List(x, 5)
Addme.Offset(0, 7) = Me.lstSelector.List(x, 6)
Addme.Offset(0, 8) = Me.lstSelector.List(x, 7)
Addme.Offset(0, 9) = Me.lstSelector.List(x, 8)
Set Addme = Addme.Offset(1, 0)
End If
Next x
'error block
On Error GoTo 0
Exit Sub
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please Contact Harin Solanki"

End Sub

Private Sub cboBooked_Change()

'enable and disable buttons based on selection
If Me.cboBooked.Value = "Available" Then
'disable Job numbers
Me.txtJob.Enabled = False
'change the button back color
Me.txtJob.BackColor = RGB(192, 192, 192)
'disable skills list
Me.cboSkills.Enabled = False
'change the button back color
Me.cboSkills.BackColor = RGB(192, 192, 192)
ElseIf Me.cboBooked.Value = "Booked" Then
cbodatetime = Now()

'enable Job numbers
Me.txtJob.Enabled = True
'change the button back color
Me.txtJob.BackColor = RGB(255, 255, 255)
'enable skills
Me.cboSkills.Enabled = True
'change the button back color
Me.cboSkills.BackColor = RGB(255, 255, 255)
End If

End Sub

Private Sub cmdBook_Click()
Dim findvalue
Dim x As Integer
Dim lCol As Variant
'error handler
On Error GoTo errHandler:
'filter criteria is sent to the sheet
Sheet2.Range("P7").Value = Me.cboBooked.Value
Sheet2.Range("O7").Value = Me.cboSkills.Value
'loop through and find list items
For x = 0 To Me.lstSelector.ListCount - 1
If Me.lstSelector.Selected(x) Then
lCol = Me.lstSelector.List(x, 3)
Set findvalue = Sheet2.Range("G:G").Find(What:=lCol, LookIn:=xlValues).Offset(0, -2)
'check that job number has been added
If Me.cboBooked.Value = "Booked" And Me.txtJob.Value = "" Then
MsgBox "You need to add a job number"
Exit Sub
End If
'add booked and job number to the database
If Me.cboBooked.Value = "Booked" Then
findvalue.Value = Me.cboBooked
findvalue.Offset(0, 1).Value = Me.txtJob
End If
'add available if selected
If Me.cboBooked.Value = "Available" Then
findvalue.Value = Me.cboBooked
findvalue.Offset(0, 1).Value = ""
End If
End If
'next selected item
Next x
'if booked then add to job allocation
If Me.cboBooked.Value = "Booked" Then Addme
'run the advanced filter with the criteria above
FilterMe
'refresh the userform
Unload Me
frmSelector.Show
'error block
On Error GoTo 0
Exit Sub
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please Contact Harin Solanki"

End Sub

 

[FormR]

but it did not worked.

This is not enough information to help you debug!

 

[hsolanki]

it works fine if the same Job has been allocated already in Sheet1 however i would like to filter through sheet 1 in color (G) for Staff ID and if duplicates found then avoid booking individual on to a Job

 

[hsolanki]

hi have managed to play around and this is what i come out with however it is finding everything duplicate

Sub Addme()

'declare the variables
Dim Addme As Range
Dim x As Integer
Dim anser As Integer
'error handler
On Error GoTo errHandler:
'find the next black row in the database
Sheet1.Unprotect Password:="Bhaji2019"
With Sheet1.Range("c710000") ' Simply Change the range to suit
.Locked = False
.FormulaHidden = False
If WorksheetFunction.CountIf(Sheet1.Range("G:G"), Me.reg4.Value) > 0 Then
answer = MsgBox("he is already on a Job" & Chr(10) & "Do you still wants to Allocate?", _
vbQuestion + vbYesNo, "Duplicate Found")
If answer = vbNo Then
Exit Sub
End If

End If
End With
'If answer = vbNo Then
'End If
'Exit Sub


'number of controls to loop through
cNum = 25

Set Addme = Sheet1.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
'loop through multi selected items and add them to the database
For x = 0 To Me.lstSelector.ListCount - 1
If Me.lstSelector.Selected(x) Then

Addme = Me.cbodatetime
Addme.Offset(0, 1) = Me.lstSelector.List(x)
Addme.Offset(0, 2) = Me.cboBooked.Value
Addme.Offset(0, 3) = Me.txtJob.Value
Addme.Offset(0, 4) = Me.lstSelector.List(x, 3)
Addme.Offset(0, 5) = Me.lstSelector.List(x, 4)
Addme.Offset(0, 6) = Me.lstSelector.List(x, 5)
Addme.Offset(0, 7) = Me.lstSelector.List(x, 6)
Addme.Offset(0, 8) = Me.lstSelector.List(x, 7)
Addme.Offset(0, 9) = Me.lstSelector.List(x, 8)
Set Addme = Addme.Offset(1, 0)
End If
Next x
'error block
On Error GoTo 0
Exit Sub
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please Contact Harin Solanki"

End Sub

 

[Fluff]

Cross posted Duplicate finds in userform data transfer

While we do allow Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.