Exporting MSP Data to Excel based on unique entries in a custom field

Hi All

I have a routine which prints individual Task Sheets in Excel for each unique Resource name.  This works perfectly well, however I now have a need to be able to print the same based on unique values in a custom field (Text16).  The current code is shown below.  Any help in modifying the code to use the unique values in Text16 would be greatly appreciated:

Sub PrintResourceCharts()
Dim xlApp As Excel.Application
Dim xlRange As Excel.Range
Dim rName As String
Dim Tsk As Task
Dim res As Resource
Dim Ass As Assignment
Dim s As Worksheet
Dim BookNam As String
Dim Row As Integer
Dim FName As String

Call summaryname
Call Task_CF_To_Resource_Usage

'Remove Existing Task List files from directory before creating new ones
On Error GoTo Finish
Kill "D:\Task List Templates\Task Lists\*.xlsm"
Finish:

'Save File Location
FName = "D:\Task List Templates\Task Lists\"

'Start Excel and Create a new Workbook
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
'Export Resource and Task details
For Each res In ActiveProject.Resources
    If res.Assignments.Count > 0 Then
        Row = 5
        xlApp.Workbooks.Open ("D:\Task List Templates\Task List Template.xlsm")
        BookNam = xlApp.ActiveWorkbook.Name
        Set s = xlApp.Workbooks(BookNam).Worksheets(1)
        For Each Ass In res.Assignments
            Set xlRange = s.Range("A5")
            If Ass.PercentWorkComplete < 100 Then
                If Ass.Finish < Now() + 28 Then
                    With xlRange
                        rName = Ass.ResourceName
                        s.Range("A" & Row).Value = Ass.ResourceName
                        s.Range("B" & Row).Value = Ass.TaskUniqueID
                        s.Range("D" & Row).Value = Ass.Text13
                        s.Range("E" & Row).Value = Ass.Start
                        s.Range("G" & Row).Value = Ass.Finish
                    End With
                End If
            End If
            Row = Row + 1
            Set xlRange = xlRange.Offset(Row, 0)  'Point to next row
        Next
        xlApp.Visible = True
        Application.DisplayAlerts = False
        If rName = "" Then
            GoTo NextOne
        End If
        xlApp.ActiveWorkbook.SaveAs FileName:= _"D:\Task List Templates\Task Lists\" & rName & ".xlsm", FileFormat:= _
            xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        rName = ""
        xlApp.ActiveWorkbook.Close savechanges:=False
        Application.DisplayAlerts = True
    End If
NextOne:
Next
xlApp.Application.Quit
Set xlApp = Nothing
MsgBox ("Individual Task Lists have now been produced....")
End Sub

Look forward to hearing from anyone who can advise.

Kind regards

Tony

TKHussar