VBA to delete rows based on user input

Apologies, I was not aware of the tags. I am not sure if I did it correctly but I did as I understood from your instructions.
Thank you so much.

Hi!

I have this code to delete an employee based on the employee id a user inputs. I placed a note on the message box because I cannot figure out how I can delete several employee id inputs all at once.

Can anybody help me add a command to delete multiple rows based on user input of employee id's (separated by semicolon)? It would also be cool to have a confirmation message like:

The following employee id's were deleted from the list:
123
456
789

The following employee id's were not found:
654
321

Sub delete_employee()
Dim lastRow As Long, x As Long
Dim resp
resp = InputBox("Enter Id of employee to delete." & vbLf & "NOTE: This action can only be done one employee id at a time.", "Delete")
If resp = "" Then Exit Sub
MsgBox ("Are you sure you want to permanently delete this employee from the list?" & vbLf & resp)
lastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
If IsDate(resp) Then
    resp = CDate(resp)
End If
For x = lastRow To 1 Step -1
    If IsDate(resp) Then
    If Cells(x, "A").Value = resp Then
        Rows(x).Delete
    End If
    End If
If Not IsDate(resp) Then
    If UCase(Cells(x, "A").Value) = UCase(resp) Then
        Rows(x).Delete
    End If
    End If
Next
End Sub

Thank you so much for all your help!

Administrative Note:

Welcome to the forum.

We would very much like to help you with your query, however you need to include code tags around your code.

Please take a moment to add the tags. Posting code between tags makes your code much easier to read and copy for testing, and it also maintains VBA formatting.

Please see Forum Rule #2 about code tags and adjust accordingly. Click on Edit to open your post, then highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

(Note: this change is not optional. No help to be offered until this moderation request has been fulfilled.)

Hello Roux11,


Try the below code

Sub DeleteEmployees()

Dim IDs As String, Del As String, NotDel As String
IDs = InputBox("Enter employee ID. If you have more than one ID, seperat them by a semicolon", "Delete IDs")
If IDs = vbNullString Then MsgBox "No IDs were selected !", vbExclamation: Exit Sub

If InStr(IDs, ";") Then
   For x = 0 To UBound(Split(IDs, ";"))
      If Columns(1).Find(Split(IDs, ";")(x), lookat:=xlWhole) Is Nothing Then
         NotDel = IIf(Len(NotDel) > 0, NotDel & vbLf & Split(IDs, ";")(x), Split(IDs, ";")(x))
      Else
         Columns(1).Find(Split(IDs, ";")(x), lookat:=xlWhole).EntireRow.Delete
         Del = IIf(Len(NotDel) > 0, Del & vbLf & Split(IDs, ";")(x), Split(IDs, ";")(x))
      End If
   Next
Else
   If Columns(1).Find(IDs, lookat:=xlWhole) Is Nothing Then NotDel = IDs Else Del = IDs: Columns(1).Find(IDs, lookat:=xlWhole).EntireRow.Delete
End If

MsgBox "Task completed" & vbLf & vbLf & "ID(s) deleted :" & vbLf & Del & vbLf & vbLf & "ID(s) NOT deleted" & vbLf & NotDel, vbInformation

End Sub

Glad to help & thanks for reporting back. If the suggested solution takes care of your request, please mark this thread as 'SOLVED' using Thread Tools from the top menu & thanks for the reps

Sure ... Line added in red below

Sub DeleteEmployees()

Dim IDs As String, Del As String, NotDel As String
IDs = InputBox("Enter employee ID. If you have more than one ID, seperat them by a semicolon", "Delete IDs")
If IDs = vbNullString Then MsgBox "No IDs were selected !", vbExclamation: Exit Sub
If (MsgBox("Are you sure you want to permanently delete these employees from the roster?", vbExclamation + vbOKCancel)) = vbCancel Then Exit Sub

If InStr(IDs, ";") Then
   For x = 0 To UBound(Split(IDs, ";"))
      If Columns(1).Find(Split(IDs, ";")(x), lookat:=xlWhole) Is Nothing Then
         NotDel = IIf(Len(NotDel) > 0, NotDel & vbLf & Split(IDs, ";")(x), Split(IDs, ";")(x))
      Else
         Columns(1).Find(Split(IDs, ";")(x), lookat:=xlWhole).EntireRow.Delete
         Del = IIf(Len(NotDel) > 0, Del & vbLf & Split(IDs, ";")(x), Split(IDs, ";")(x))
      End If
   Next
Else
   If Columns(1).Find(IDs, lookat:=xlWhole) Is Nothing Then NotDel = IDs Else Del = IDs: Columns(1).Find(IDs, lookat:=xlWhole).EntireRow.Delete
End If

MsgBox "Task completed" & vbLf & vbLf & "ID(s) deleted :" & vbLf & Del & vbLf & vbLf & "ID(s) NOT deleted" & vbLf & NotDel, vbInformation

End Sub

I'm not able to replicate your file to solve this issue … Is the above worksheet event code placed in the same sheet where the DeleteEmployees macro is working ? What is the name of that sheet. Also, is Sheet3 a third sheet ? Please provide a small sample file to see the issue with the exact sheet names as per your file just with dummy data

Try to put the red line in your worksheet event code & see if that solves the problem

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim cel As Range
Dim myRow As Long

If target.columns.count>1 then exit sub
Set ws = ThisWorkbook.Sheets("Termed")

If Not Intersect(Target, Range("A4:A13")) Is Nothing Then ' watch all the cells in this range
    For Each cel In Target ' do the next steps for each cell that was changed
        myRow = cel.Row
        Range("j1").Copy Cells(Target.Row, 4)
        Range("E" & myRow).Value = Date
        Range("F" & myRow).Value = "Termed"
        Application.EnableEvents = False
        If IsEmpty(ws.Range("A" & myRow)) Then Sheet3.Range("D" & myRow).Value = ""
        If IsEmpty(ws.Range("A" & myRow)) Then Sheet3.Range("E" & myRow).Value = ""
        If IsEmpty(ws.Range("A" & myRow)) Then Sheet3.Range("F" & myRow).Value = ""
        Application.EnableEvents = True
    Next cel
End If

End Sub

You don't need the copy, you can assign the value directly like below

Cells(Target.Row, 4) = Range("j1").value