Good Morning -

I've gotten to about 90% of where I need to be thanks to help from this forum and JBeacaire and just need a little push to the end.

Currently the script I am using is is splitting out a worksheet into seperate worksheets based on unique values in column L, Adds subtotals to the bottom of column W and Z and changes my amounts to Accounting format.

Essentially the last thing I need is to have every new sheet being created to be named the value in AE2.
My problem with this is that as you can see from the attached example (confidential information is X'd out) Column AE contains values larger than 31 characters and also some characters that are not allowed in sheet names. (/ for example)

What I'm wondering is if someone can help me add something in to delete all non-allowed characters from column AE, Trim Column AE to 31 characters and then when the sheets are being added name them the value in column AE.

I've found a workaround just doing the format manually and using a name change Macro but I was just hoping to combine it into this macro to avoid having to run two. Any help with this will be greatly appreciated.

*Original Macro Script to split sheets is from JBeaucaire*

Option Explicit
Sub ParseItems()

Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long, iCol As Long
Dim ws As Worksheet, MyArr As Variant, vTitles As String, TitleRow As Long

Application.ScreenUpdating = False

   vCol = 12
   Set ws = Sheets("Sheet1")
   vTitles = "A1:AJ1"

   TitleRow = Range(vTitles).Cells(1).Row
   LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row

    iCol = ws.Columns.Count
    ws.Cells(1, iCol) = "key"
    
    For Itm = 2 To LR
        On Error Resume Next
        If ws.Cells(Itm, vCol) <> "" And Application.WorksheetFunction _
            .Match(ws.Cells(Itm, vCol), ws.Columns(iCol), 0) = 0 Then
               ws.Cells(ws.Rows.Count, iCol).End(xlUp).Offset(1) = ws.Cells(Itm, vCol)
        End If
    Next Itm
    ws.Columns(iCol).Sort Key1:=ws.Cells(2, iCol), Order1:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

    MyArr = Application.WorksheetFunction.Transpose _
        (ws.Columns(iCol).SpecialCells(xlCellTypeConstants))

    ws.Columns(iCol).Clear
    ws.Range(vTitles).AutoFilter
    For Itm = 2 To UBound(MyArr)
        ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm) & ""
    
        If Not Evaluate("=ISREF('" & MyArr(Itm) & "'!A1)") Then    'create sheet if needed
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyArr(Itm) & ""
        Else                                                      'clear sheet if it exists
            Sheets(MyArr(Itm) & "").Move After:=Sheets(Sheets.Count)
            Sheets(MyArr(Itm) & "").Cells.Clear
        End If
    
        ws.Range("A" & TitleRow & ":A" & LR).EntireRow.Copy _
            Sheets(MyArr(Itm) & "").Range("A1")
        
        ws.Range(vTitles).AutoFilter Field:=vCol
        MyCount = MyCount + Sheets(MyArr(Itm) & "").Range("A" & Rows.Count) _
                             .End(xlUp).Row - Range(vTitles).Rows.Count
       Sheets(MyArr(Itm)).Range("W" & Rows.Count).End(xlUp).Offset(2).FormulaR1C1 = "=SUBTOTAL(9, R1C:R[-1]C)"
       Sheets(MyArr(Itm)).Range("Z" & Rows.Count).End(xlUp).Offset(2).FormulaR1C1 = "=SUBTOTAL(9, R1C:R[-1]C)"
       Range("W1").EntireColumn.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
       Range("X1").EntireColumn.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
       Range("Y1").EntireColumn.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
       Range("Z1").EntireColumn.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
       Range("Z:Z").End(xlDown).Offset(2).Font.Bold = True
       Range("W:W").End(xlDown).Offset(2).Font.Bold = True
        
        Sheets(MyArr(Itm) & "").Columns.AutoFit
    Next Itm
    
    ws.AutoFilterMode = False
        ws.Activate
    MsgBox "Rows with data: " & (LR - TitleRow) & vbLf & "Rows copied to other sheets: " _
                & MyCount & vbLf & "Hope they match!!" Application.ScreenUpdating = True
End Sub
TEST.xls