Need help breaking a report into mulitple sorted/formatted reports

This is my first post so forgive me if I do anything incorrectly. I have a test file with about 50 records. Each record contains a serial number of a device and an application that is installed on that device as well as additional information. My ultimate goal is to have the macro break this report into individual reports for each workstation. In addition to that I would like certain records to be deleted and others sorted into sections based on whether or not the application appears in a preset list in another worksheet. I've attached 3 files. The Mock file contains the macro. It has 4 sheets (EXAMPLE, DELETE, SECTION1, SECTION2). TestFile contains test data. Machine1 contains what the macro currently outputs. Right now the output is just a sheet with the list of apps for a specific machine. Looking at the EXAMPLE worksheet you can see how I would like it ultimately formatted. Any apps present in the DELETE Worksheet should be deleted. Any apps in the REPLACE worksheet should have the replacement put in section 1. Any Apps in the SECTION2 worksheet should be put in Section 2. All remaining records should be put in Section 3. I've never used VBA but what code you see I was able to put together in a day and a half so i'm a quick learner. Any help would be appreciated!

Note: some code is for future purposes such as SetHeaderInfo(). Also this requires a directory of "C:\WKSTEMP\" to save the files.

Here is the current macro:

Sub MultiFormat()
'
' Keyboard Shortcut: Ctrl+m
'
' This macro will process an exported report with multiple machine data into individual machine reports and save the reports using the MachineID as the file name.
'
' Macro begins now...

' Dimension variables

Dim OrigWS As String
OrigWS = ActiveSheet.Name
    
' Strip Header Row
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    
' Parse file

'Based on column A, data is filtered to individual sheets
'Creates sheets and sorts alphabetically in workbook
Dim LR As Long, i As Long, MyArr
Dim MyCount As Long, ws As Worksheet
Application.ScreenUpdating = False

Set ws = Sheets(OrigWS)      'edit to sheet with master data
ws.Activate

Rows(1).Insert xlShiftDown
Range("A1") = "Key"
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("CC1"), Unique:=True
Columns("CC:CC").Sort Key1:=Range("CC2"), Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
MyArr = Application.WorksheetFunction.Transpose(Range("CC2:CC" & Rows.Count).SpecialCells(xlCellTypeConstants))

Range("CC:CC").Clear
Range("A1").AutoFilter

For i = 1 To UBound(MyArr)
    ws.Range("A1").AutoFilter Field:=1, Criteria1:=MyArr(i)
    LR = ws.Range("A" & Rows.Count).End(xlUp).Row
    If LR > 1 Then
        If Not Evaluate("=ISREF('" & MyArr(i) & "'!A1)") Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyArr(i)
        Else
            Sheets(MyArr(i)).Move After:=Sheets(Sheets.Count)
            Sheets(MyArr(i)).Cells.Clear
        End If
        ws.Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Sheets(MyArr(i)).Range("A1")
        ws.Range("A1").AutoFilter Field:=1
        MyCount = MyCount + Sheets(MyArr(i)).Range("A" & Rows.Count).End(xlUp).Row - 1
        Sheets(MyArr(i)).Columns.AutoFit
        SetHeaderInfo
        FormatData
        SaveTitleClose
    End If
Next i

' Display success message

ws.Activate
ws.AutoFilterMode = False
LR = ws.Range("A" & Rows.Count).End(xlUp).Row - 1
Rows(1).Delete xlShiftUp
MsgBox "Rows with data: " & LR & vbLf & "Your files have been created! Please check them."
Application.ScreenUpdating = True

' Close the report data file

ActiveWorkbook.Close Saved = True

End Sub

Public Function FormatData()
' Delete unused columns and rows
    Columns("A:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:I").Select
    Selection.Delete Shift:=xlToLeft
' Change font size
    Cells.Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
' Set column width to auto
    Columns("A:G").Select
    Selection.Columns.AutoFit
End Function

Public Function SaveTitleClose()
' Save worksheet as new workbook, set title, and close.
    Dim wb As Workbook
    Dim Name As String
    Name = ActiveSheet.Name
    Worksheets(Name).Copy
    Set wb = ActiveWorkbook
    wb.BuiltinDocumentProperties("title") = Name & " Applications List"
    wb.SaveAs FileName:="C:\WKSTEMP\" & Name & ".xlsx", FileFormat:=51
    wb.Close
' Close the new worksheet
    Application.DisplayAlerts = False
    Worksheets(Name).Delete
    Application.DisplayAlerts = True

End Function

Public Function SetHeaderInfo()
    Dim UserID As String
    UserID = Range("B2").Value
    Dim UserDep As String
    UserDep = Range("D2").Value
End Function

I have 2 posts and i haven't gotten a response for either. I don't mean to be impatient. I just want to make sure I haven't done anything wrong to cause people to avoid helping me. These are my first posts. If anyone could kindly point me in the right direction I would appreciate the help. Thanks

The data that needs to be extracted is represented in the Machine1 file attached. This includes Columns L through Q from the original file. This is what is currently being output by the macro so far but I am not opposed to going a different route if you have a better way. I basically stripped the rest of the data using my FormatData() function but I did pull columns B, and D as well using the SetHeader() function. The info from those columns is used in the top section of the final report. (Also note that Column A was used to generate the name of the new worksheets and thus the new files.) There is probably a more straightforward way to get what I wanted but I am working from a limited skill set. Thanks for your help. Also you responded to my other post which was me working on this from a different direction so don't worry about that post unless you're interested in the code I was working on to sort the data. Thanks!

someone or me will help u .. dont worry

I've made some very good progress so I thought I would share where I am. I've also attached new files to work from for anyone trying to assist me. If you look at the Machine1 file you will see I've been able to insert the header with the correct info and classify the files using the numbers 0-3. Using numbers made it easy to sort. In the resulting file "Machine1" you'll notice there are no 0's. These were deleted as was part of my requirements. Now what I need to do is insert Section2 and Section3 Headers as well as replace any records marked as 1 with their replacements (See sheet named "SECTION1") I would also like some error checking as I realized that actual data may not have files marked as 1 2 or 3. I'm working hard but any help is greatly appreciated

New code is below:

Sub MultiFormat()
'
' Keyboard Shortcut: Ctrl+m
'
' This macro will process an exported report with multiple machine data into individual machine reports and save the reports using the MachineID as the file name.
'
' Macro begins now...

' Dimension variables

Dim OrigWS As String
OrigWS = ActiveSheet.Name
    
' Strip Header Row
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    
' Parse file

'Based on column A, data is filtered to individual sheets
'Creates sheets and sorts alphabetically in workbook
Dim LR As Long, i As Long, MyArr
Dim MyCount As Long, ws As Worksheet
Application.ScreenUpdating = False

Set ws = Sheets(OrigWS)      'edit to sheet with master data
ws.Activate

Rows(1).Insert xlShiftDown
Range("A1") = "Key"
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("CC1"), Unique:=True
Columns("CC:CC").Sort Key1:=Range("CC2"), Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
MyArr = Application.WorksheetFunction.Transpose(Range("CC2:CC" & Rows.Count).SpecialCells(xlCellTypeConstants))

Range("CC:CC").Clear
Range("A1").AutoFilter

For i = 1 To UBound(MyArr)
    ws.Range("A1").AutoFilter Field:=1, Criteria1:=MyArr(i)
    LR = ws.Range("A" & Rows.Count).End(xlUp).Row
    If LR > 1 Then
        If Not Evaluate("=ISREF('" & MyArr(i) & "'!A1)") Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyArr(i)
        Else
            Sheets(MyArr(i)).Move After:=Sheets(Sheets.Count)
            Sheets(MyArr(i)).Cells.Clear
        End If
        ws.Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Sheets(MyArr(i)).Range("A1")
        ws.Range("A1").AutoFilter Field:=1
        MyCount = MyCount + Sheets(MyArr(i)).Range("A" & Rows.Count).End(xlUp).Row - 1
        ' Store header info, format data
        Dim UserID As String
        UserID = Range("B2").Value
        Dim UserDep As String
        UserDep = Range("D2").Value
        FormatData
        ' Compare applicatiosn against lists
        Compare
        ' Update calculations
        Application.Calculate
        ' Delete Core applications (those marked 0)
        DelRec
        ' Sort ascending by column J
        SortAscending
        ' Paste header in new worksheet
        ThisWorkbook.Activate
        Rows("1:7").Select
        Selection.Copy
        ws.Activate
        Sheets(MyArr(i)).Activate
        Range("A1").Select
        Selection.Insert Shift:=xlDown
        ' Paste Section2 Header
        ' Code Here
        ' Paste Section3 Header
        ' Code Here
        ' Set User and Load
        Range("B1").Value = UserID
        Range("B3").Value = UserDep
        ' Set column width to auto
        Columns("A:I").Select
        Selection.Columns.AutoFit
        'Save, title, and close
        SaveTitleClose
    End If
Next i

' Display success message

ws.Activate
ws.AutoFilterMode = False
LR = ws.Range("A" & Rows.Count).End(xlUp).Row - 1
Rows(1).Delete xlShiftUp
MsgBox "Rows with data: " & LR & vbLf & "Your files have been created! Please check them."
Application.ScreenUpdating = True

' Close the report data file

ActiveWorkbook.Close Saved = True

End Sub

Public Function FormatData()
' Delete unused columns and rows
    Columns("A:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:I").Select
    Selection.Delete Shift:=xlToLeft
' Change font size
    Cells.Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 10
    End With
End Function

Public Function SaveTitleClose()
' Save worksheet as new workbook, set title, and close.
    Dim wb As Workbook
    Dim Name As String
    Name = ActiveSheet.Name
    Worksheets(Name).Copy
    Set wb = ActiveWorkbook
    wb.BuiltinDocumentProperties("title") = Name & " Applications List"
    wb.SaveAs FileName:="C:\WKSTEMP\" & Name & ".xlsx", FileFormat:=51
    wb.Close
' Close the new worksheet
    Application.DisplayAlerts = False
    Worksheets(Name).Delete
    Application.DisplayAlerts = True

End Function

Public Function Compare()
    MaxRowNumber = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    AutoFillRange = "J1:J" & MaxRowNumber
    Range("J1").Select
    ActiveCell.FormulaR1C1 = _
       "=IF(ISERROR(VLOOKUP(R[0]C[-9], [MOCK.xlsm]DELETE!R1C1:R500C1, 1, FALSE)), IF(ISERROR(VLOOKUP(R[0]C[-9], [MOCK.xlsm]SECTION1!R1C1:R500C1, 1, FALSE)), IF(ISERROR(VLOOKUP(R[0]C[-9], [MOCK.xlsm]SECTION2!R1C1:R500C1, 1, FALSE)), 3, 2), 1), 0)"
    Range("J1").Select
    Selection.AutoFill Destination:=Range(AutoFillRange), Type:=xlFillDefault
End Function

Public Function DelRec()
    ' This deletes rows containing the value 0 in column J

    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long

    'We use the ActiveSheet but you can replace this with
    'Sheets("MySheet")if you want
    With ActiveSheet

        'Set the first and last row to loop through
        Firstrow = .UsedRange.Cells(1).Row
        Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        'We loop from Lastrow to Firstrow (bottom to top)
        For Lrow = Lastrow To Firstrow Step -1

            'We check the values in the J column in this example
            With .Cells(Lrow, "J")

                If Not IsError(.Value) Then

                    If .Value = 0 Then .EntireRow.Delete
                    'This will delete each row with the Value 0
                    'in Column J, case sensitive.

                End If

            End With

        Next Lrow

    End With

End Function

Public Function SortAscending()
    MaxRowNumber = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    Range("A1:J" & MaxRowNumber).Sort Key1:=Range("J1"), Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End Function