VBA Help splitting data based on a ID #

[Paul_Hossler]

Something like this should get you started

Option Explicit


Sub SplitID()
    Dim i As Long
    Dim r As Range
    Dim C As Collection
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim ID As String, W As String
    
    Application.ScreenUpdating = False
    
    Set r = ActiveSheet.Cells(1, 1).CurrentRegion

    Set C = New Collection
    
    'make unique list
    On Error Resume Next
    For i = 2 To r.Rows.Count
        C.Add r.Cells(i, 1).Value, CStr(r.Cells(i, 1).Value)
    Next i
    On Error GoTo 0


    For i = 1 To C.Count
    
        'get the ID
        ID = C.Item(i)
        
        'delete ws with that ID just in case
        On Error Resume Next
        Application.DisplayAlerts = False
        Worksheets(ID).Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        
        'add ws named ID
        Worksheets.Add
        Set ws = ActiveSheet
        ws.Name = ID
        
        'filter data on ID
        r.AutoFilter Field:=1, Criteria1:=ID
        
        'copy to ID ws
        r.SpecialCells(xlCellTypeVisible).Copy ws.Range("A1")


        'get wb name
        W = ThisWorkbook.Path & Application.PathSeparator & ID & ".xlsx"
        
        'delete wb with that ID just in case
        On Error Resume Next
        Application.DisplayAlerts = False
        Kill W
        Application.DisplayAlerts = True
        On Error GoTo 0
        
        'copy ws to new wb
        ws.Move
        Set wb = ActiveWorkbook
        wb.SaveAs W, xlWorkbookDefault
        wb.Close False
        
        ThisWorkbook.Activate
    Next i


    ActiveSheet.AutoFilterMode = False


    Application.ScreenUpdating = False


    
    MsgBox "Done"


End Sub