Hello,
I am trying to set code that will look for a specific piece of data in 2 different worksheets (same workbook) and delete the entire row in both table at the same time. More specifically, I have an employee database. There is a worksheet for the empoloyee roster, and another for an employee emergency contact. When an employee leaves we delete him or her from the database, but the contact sheet gets missed. I want to have the delete function remove both the employee record and the contact data based on the employee ID#. I have an add function that works great to both add the employee record and emergency contact data in one motion, but not the delete. I have ried to combine the commands and run seperately as shown below. Any help is appreciated. Just keep it simple, still learning.
Here is what I have for add/delete The delete keeps throwing me this error.
I am trying to set code that will look for a specific piece of data in 2 different worksheets (same workbook) and delete the entire row in both table at the same time. More specifically, I have an employee database. There is a worksheet for the empoloyee roster, and another for an employee emergency contact. When an employee leaves we delete him or her from the database, but the contact sheet gets missed. I want to have the delete function remove both the employee record and the contact data based on the employee ID#. I have an add function that works great to both add the employee record and emergency contact data in one motion, but not the delete. I have ried to combine the commands and run seperately as shown below. Any help is appreciated. Just keep it simple, still learning.
Here is what I have for add/delete The delete keeps throwing me this error.
VBA Code:
[B]Private Sub cmdAdd_Click()[/B]
Dim Staff_DataSH As Worksheet
Dim EAPSearchSH As Worksheet
Dim addme As Range
Dim lrEAPS As Long, lrSD As Long
Dim Drng As Range
Set Staff_DataSH = Sheet7
Set EAPSearchSH = Sheet19
On Error GoTo errHandler:
Set addme = Staff_DataSH.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
Application.ScreenUpdating = False
If WorksheetFunction.CountIf(Sheet7.Range("B9:B1000"), Me.cboPosition.Value) > 0 Then
MsgBox "This Position # is already assigned. Delete the vacant position before assigning to a new employee"
End If
Exit Sub
If Me.txtFirst = "" Or Me.txtLast = "" Or Me.txtEmp = "" Or Me.cboType = "" Or Me.txtHired = "" Or Me.cboPosition = "" Or Me.cboStatus = "" Or _
Me.cboClass = "" Or Me.cboCDL = "" Or Me.cboACd = "" Or Me.cboOC1 = "" Or Me.cboAP1 = "" Then
MsgBox "information missing. Complete all information to set up new employee"
If Me.txtEmail = "" Or txtWork = "" Or txtMobile = "" Then
MsgBox "'Emergency Contact' information missing. If no work phone, use home phone or duplicate the mobile information."
End If
End If
Exit Sub
With Staff_DataSH
addme.Offset(0, -1) = Staff_DataSH.Range("B6").Value + 1
addme.Value = Me.cboPosition
addme.Offset(0, 1).Value = Format(Me.txtHired.Value, "mm/dd/yyyy")
addme.Offset(0, 2).Value = Me.cboStatus
addme.Offset(0, 3).Value = Format(Me.txtEmp.Value, "###0")
addme.Offset(0, 6).Value = Me.txtFirst
addme.Offset(0, 7).Value = Me.txtLast
txtFull_Change
addme.Offset(0, 10).Value = Me.cboType
addme.Offset(0, 11).Value = Format(Me.cboClass.Value, "###0")
addme.Offset(0, 18).Value = Format(Me.cboACd.Value, "##0")
addme.Offset(0, 19).Value = Format(Me.cboAP1.Value, "0%")
addme.Offset(0, 20).Value = Format(Me.cboOC1.Value, "#######0")
addme.Offset(0, 21).Value = Format(Me.cboAP2.Value, "0%")
addme.Offset(0, 22).Value = Format(Me.cboOC2.Value, "#######0")
addme.Offset(0, 23).Value = Me.cboCDL
addme.Offset(0, 24).Value = Me.cboCert1
addme.Offset(0, 25).Value = Me.cboCert2
addme.Offset(0, 26).Value = Me.cboCert3
addme.Offset(0, 27).Value = Me.cboCert4
addme.Offset(0, 28).Value = Me.cboCert5
addme.Offset(0, 29).Value = Me.cboCert6
addme.Offset(0, 30).Value = Me.cboCert7
addme.Offset(0, 31).Value = Me.cboCert8
'addme.Offset(0, 32).Value = Me.cboCert9
End With
With EAPSearchSH
Set Drng = Sheet19.Range("B6")
Drng.End(xlDown).Offset(1, 0).Value = Me.txtLast.Value 'Me.EAP2.Value
Drng.End(xlDown).Offset(0, 1).Value = Me.txtFirst 'Me.EAP3.Value
Drng.End(xlDown).Offset(0, 2).Value = Me.txtEmp.Value 'Me.EAP4.Value
'Drng.End(xlDown).Offset(0, 3).Value = Me.EAP5.Value
Drng.End(xlDown).Offset(0, 4).Value = Me.txtWork.Value 'Me.EAP6.Value
Drng.End(xlDown).Offset(0, 5).Value = Me.txtMobile.Value 'Me.EAP7.Value
Drng.End(xlDown).Offset(0, 6).Value = Me.txtEmail.Value 'Me.EAP8.Value
Drng.End(xlDown).Offset(0, 7).Value = Me.txtEmpEAP.Value 'Me.EAP9.Value
Drng.End(xlDown).Offset(0, 8).Value = Drng.End(xlDown).Offset(-1, 8).Value + 1
End With
With Staff_DataSH
Sortit
SortitEAP
End With
Clear
MsgBox "Employee was successfully added to the Master Staffing database"
Call MsgBox("Emergency contact & information has been created in the EAP Contact List", vbInformation, "Add Contact")
On Error GoTo 0
Exit Sub
errHandler:
MsgBox "Error " & Err.Number & _
"(" & Err.Description & ") in 'frmEmployeeDB', procedure 'cmdAdd2', of the page 'Add New Employee'"
End Sub
[B]Private Sub cmdDeleteEmp_Click()[/B]
Dim findvalue As Range
Dim cDelete As VbMsgBoxResult
Dim cNum As Integer
On Error GoTo cmdDeleteEmp_Error:
If Emp3.Value = "" Then 'Or Emp4.Value = ""
MsgBox "There is no data to delete"
Exit Sub
End If
cDelete = MsgBox("Are you sure that you want to delete this record. This action cannot be undone.", vbYesNo + vbDefaultButton2, "Click to confirm")
If cDelete = vbYes Then
Set findvalue = Sheet7.Range("A9:A1000").Find(What:=Emp1, LookIn:=xlValues)
findvalue.EntireRow.Delete
[COLOR=rgb(184, 49, 47)] cmdDeleteEAP[/COLOR]
End If
cNum = 31
For x = 1 To cNum
Me.Controls("Emp" & x).Value = ""
Next
Unprotect_All
AdvFilterArchive
lstEmployee.RowSource = ""
lstEmployee.RowSource = "OutData"
SortitEAP
On Error GoTo 0
Protect_All
Exit Sub
cmdDeleteEmp_Error:
Protect_All
MsgBox "Error" & Err.Number & " (" & Err.Description & ") in procedure cmdDeleteEmp _Click of Form EmployeeDB"
End Sub
[B]Private Sub cmdDeleteEAP()[/B]
Dim findvalue As Range
On Error GoTo cmdDeleteEAP_Click_Error
Select Case MsgBox("You are about to delete a contact." & vbCrLf & "Do you want to proceed?", vbYesNo Or vbQuestion Or vbDefaultButton1, "Click YES to confirm")
Case vbYes
Case vbNo
Exit Sub
End Select
Set findvalue = Sheet19.Range("C6:C10000").Find(What:=Me.Emp32, LookIn:=xlValues)
findvalue.Value = ""
findvalue.Offset(0, -1).Value = "" [COLOR=rgb(65, 168, 95)]'Employee ID#[/COLOR]
findvalue.Offset(0, 1).Value = ""
findvalue.Offset(0, 2).Value = ""
findvalue.Offset(0, 3).Value = ""
findvalue.Offset(0, 4).Value = ""
findvalue.Offset(0, 5).Value = ""
findvalue.Offset(0, 6).Value = ""
findvalue.Offset(0, 7).Value = ""
findvalue.Offset(0, 8).Value = ""
findvalue.Offset(0, 9).Value = "" [COLOR=rgb(65, 168, 95)]'Record Number[/COLOR]
SortitEAP
On Error GoTo 0
Exit Sub
cmdDeleteEAP_Click_Error:
MsgBox "Error" & Err.Number & " (" & Err.Description & ") in procedure cmdDeleteEAP_Click of Form Emergency_Contact_List"
End Sub
[B]Sub SortitEAP()[/B]
ActiveWorkbook.Worksheets("EAPData").ListObjects("EAPOut").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("EAPData").ListObjects("EAPOut").Sort.SortFields. _
Add2 Key:=Range("EAPOut[Last Name]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("EAPData").ListObjects("EAPOut").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A7").Select
End Sub
