VBA/Macro Automatically remove lines in tables on different tabs that start with employee ID

[kizzie37]

I think this is a simple enough request but I'm not sure how to execute simply and flawlessly.

I have a workbook with multiple tabs, each tab contains a table

Tab names (exactly as listed):

Misc Info
IT Equipment & Phones
Computer Equipment
Education & Training
Committees
Facilities
Atlas
CurrentWorker

The first cell/column in each tab contains an Employee ID (column labelled ID)

When I Type an ID number into the Tab "Remove Employee" Cell C3 I would like the macro to delete the line in each table on each of the tabs listed above that is associated with that ID number.

Can anyone assist with this please.

 

[igold]

This...

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
    If Not Target = Range("C3") Then Exit Sub
    Dim tbl As ListObject, rw As Long, arr, i As Long
    Dim nam As String, r As Range
    
    arr = Array("Misc Info", "IT Equipment & Phones", "Computer Equipment", "Education & Training", "Committees", "Facilities", "Atlas", "CurrentWorker")
    nam = Target.Value
    For i = 0 To 7
        With worksheets(arr(i))
            Set tbl = .ListObjects(1)
            Set r = .ListObjects(1).DataBodyRange.Columns(1).Find(nam, LookAt:=xlWhole)
            If Not r Is Nothing Then
                rw = r.Row - tbl.HeaderRowRange.Row
                 tbl.ListRows(rw).Delete
            End If
        End With
    Next
    
End Sub

 

[kizzie37]

This...

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
    If Not Target = Range("C3") Then Exit Sub
    Dim tbl As ListObject, rw As Long, arr, i As Long
    Dim nam As String, r As Range
   
    arr = Array("Misc Info", "IT Equipment & Phones", "Computer Equipment", "Education & Training", "Committees", "Facilities", "Atlas", "CurrentWorker")
    nam = Target.Value
    For i = 0 To 7
        With worksheets(arr(i))
            Set tbl = .ListObjects(1)
            Set r = .ListObjects(1).DataBodyRange.Columns(1).Find(nam, LookAt:=xlWhole)
            If Not r Is Nothing Then
                rw = r.Row - tbl.HeaderRowRange.Row
                 tbl.ListRows(rw).Delete
            End If
        End With
    Next
   
End Sub

Works like a charm! thank you so much!

 

[igold]

You're welcome. I was happy to help. I knew we would get there sooner or later. Thanks for the feedback!

 

[kizzie37]

You're welcome. I was happy to help. I knew we would get there sooner or later. Thanks for the feedback!

Hi, I just noticed an issue with this.

Only one of my Tabs and the table within it uses an actual number (Current worker Detail, Column A uses ID number) all my other tabs the first column of each table is using a formula that pulls the ID from the Current worker Detail tab, (Column A, 1st cell so that no manual entry is required for each tab)

Problem is the macro isn't deleting the rows for all those tabs, just for the current worker Detail tab, presumably because its the only one using an actual number stored as text? for the others the row remains with #VALUE errors. Can this be fixed?

It kind of defeats the purpose of having a macro to remove the rows if I have to manually deleted the #VALUE rows

 

[igold]

Try this change...

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Target = Range("C3") Then Exit Sub
    Dim tbl As ListObject, rw As Long, arr, i As Long
    Dim nam, r As Range
    
    arr = Array("Misc Info", "IT Equipment & Phones", "Computer Equipment", "Education & Training", "Committees", "Facilities", "Atlas", "CurrentWorker")
    nam = Target.Value
    For i = 0 To 7
        With worksheets(arr(i))
            Set tbl = .ListObjects(1)
            Set r = .ListObjects(1).DataBodyRange.Columns(1).Find(nam, LookIn:=xlValues)
            If Not r Is Nothing Then
                rw = r.Row - tbl.HeaderRowRange.Row
                 tbl.ListRows(rw).Delete
            End If
        End With
    Next
    
End Sub