Employee training database: Delete an employee completely

[Ninja_nutter]

Hello everyone,

At work I have inherited an Excel employee training database. The details of an employee are entered into a user form and can be edited/updated or deleted. The issue I have is that when you go to delete an employee completely, you have to select the employee from the listbox of training courses then delete each line entry. As the criteria is looking for the employees unique employment number, I would like the code to loop through until that unique identifier is completely deleted.

Here is the code:

Private Sub cmdDeleteA_Click()
    'declare the variables
    Dim findvalue As Range
    Dim cDelete As VbMsgBoxResult
    Dim cNum As Integer


'error statement
        On Error GoTo errHandler:
'check for values
        If Reg1.Value = "" Or Reg4.Value = "" Then
             MsgBox "There is not data to delete"
        Exit Sub
    End If


    'give the user a chance to change their mind
         cDelete = MsgBox("Are you sure that you want to delete this person", vbYesNo + vbDefaultButton2, "Are you sure????")
    If cDelete = vbYes Then


    'find the employee
        Set findvalue = Sheet2.Range("F:F").Find(What:=Reg4, LookIn:=xlValues)
        findvalue.EntireRow.Delete
    End If


    'clear the controls
        cNum = 9
        For X = 1 To cNum
        Me.Controls("Reg" & X).Value = ""
    Next


'run the filter
    AdvFilter


'add the values to the listbox
    lstLookup.RowSource = ""
    lstLookup.RowSource = "Filter_Staff"
'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 notify the administrator"
End Sub

As i am a newbie to VBA coding any help would be greatly appreciated.

Thanks in advance.

 

[dmt32]

Hi,
untested but see if this update to your code does what you want

Private Sub cmdDeleteA_Click()
'declare the variables
    Dim findvalue As Range, deleterange As Range
    Dim cDelete As VbMsgBoxResult
    Dim cNum As Integer
    Dim firstaddress As String, Search As String
    
    
'error statement
    On Error GoTo errHandler:
    
    Search = Reg4.Value
    
'check for values
        If Len(Search) = 0 Then MsgBox "There is not data to delete", 48, "No Data": Reg4.SetFocus: Exit Sub
    
'find the employee
    Set findvalue = Sheet2.Range("F:F").Find(What:=Search, LookIn:=xlValues, lookat:=xlWhole)
    
    If Not findvalue Is Nothing Then
        
'give the user a chance to change their mind
        cDelete = MsgBox(Search & Chr(10) & _
                        "Are you sure that you want to delete this person.", 292, "Are you sure????")
        If cDelete = vbNo Then Exit Sub
        
'mark first match address
        firstaddress = findvalue.Address
'create union of matching ranges
        Do
            If deleterange Is Nothing Then
                Set deleterange = findvalue
            Else
                Set deleterange = Union(deleterange, findvalue)
            End If
'find next match
            Set findvalue = Sheet2.Range("F:F").FindNext(findvalue)
            
        Loop While firstaddress <> findvalue.Address
        
'delete all matches in one go
        If Not deleterange Is Nothing Then deleterange.EntireRow.Delete
        
'clear the controls
        cNum = 9
        For X = 1 To cNum
            Me.Controls("Reg" & X).Value = ""
        Next
        
'run the filter
        AdvFilter
           
'add the values to the listbox
        lstLookup.RowSource = ""
        lstLookup.RowSource = "Filter_Staff"
        
        MsgBox Search & Chr(10) & "Record(s) Deleted", 64, "Record Deleted"
        
    Else
    
        MsgBox Search & Chr(10) & "Record Not Found", 48, "Not Found"
        
    End If
    
errHandler:
    If Err <> 0 Then
        MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _
        & Err.Number & vbCrLf & Err.Description & vbCrLf & _
        "Please notify the administrator", 48, "Error"
    End If
End Sub

As a thought, rather than permanently deleting records, consider archiving them to another sheet or workbook for future reference.

Hope Helpful

Dave

 

[Ninja_nutter]

Hi Dave,

That works really well!! Thank you so much.

We have considered archiving the employee's records, however the senior management decided against it.

 

[dmt32]

Hi Dave,

That works really well!! Thank you so much.

We have considered archiving the employee's records, however the senior management decided against it.

Glad update did what you wanted

If want to archive, would quite simple to modify code in future.

Forgot to add in my post that I removed this part in your code

If Reg1.Value = ""

as it was not doing anything - I wondered if it may be used as Forename maybe? but control naming convention not clear.


Dave

 

[Ninja_nutter]

Glad update did what you wanted

If want to archive, would quite simple to modify code in future.

Forgot to add in my post that I removed this part in your code

If Reg1.Value = ""

as it was not doing anything - I wondered if it may be used as Forename maybe? but control naming convention not clear.


Dave

Hi Dave,

Noted. Reg1 value was a surname, however Reg4 is the unique employee number.

Thanks again for the help.