VBA match table data to Advanced Filter, paste values in new tab

25 Views Asked by At

I have a table of employee data with their managers' emails in column "TK Email" in table "All." I want a new tab for each unique manager with each of their employees listed in their tab. I created a temporary column to Advanced Filter for unique values and match the TK Email cells to those unique values, and create an array of data to paste into each tab. What is throwing me is that it is working for the first manager, but for the rest it is only pasting the headers. Please help.

Sub Test()

    Dim table As ListObject
    Dim rng As Range
    Dim datarng As Range
    Dim hdr As Range
    Dim top As Range
    Dim UqMngrs As Range
    Dim erow As Range
    Dim email
    Dim data
    
    Set table = ThisWorkbook.Sheets("ISSUES").ListObjects("All")
    Set rng = table.ListColumns("TK Email").DataBodyRange
    
    table.ListColumns.Add(1).Name = "Unique"
    
    Set top = table.HeaderRowRange(1)
    Set hdr = Range(top, top.End(xlToRight))
    Set UqMngrs = table.ListColumns("Unique").DataBodyRange
    
    rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=UqMngrs, Unique:=True
              
    For Each mgr In UqMngrs.Offset(1, 0)
    
        email = mgr.Value
        Set datarng = hdr
        If Not IsEmpty(mgr) Then
        

        ThisWorkbook.Sheets.Add
                
            For Each cell In rng
                
                Set erow = Range(cell.Offset(0, 1), cell.End(xlToRight))
                
                If cell.Value = email Then
                Set datarng = union(datarng, erow)
                End If
                 
            Next cell

        data = datarng.Value
        ActiveSheet.Range("A1:G1").Resize(UBound(data, 1)).Value = data
        ActiveSheet.Columns("A:G").AutoFit
        
        End If
        
        Next mgr
        
        table.ListColumns("Unique").Delete
        
    End Sub
0

There are 0 best solutions below