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

Hi Tony,

>>I now have a need to be able to print the same based on unique values in a custom field (Text16). <<

As far as I konw, we can write data into the specific cell via Range object and here is an example places the value of cell A1 in cell A5.

Worksheets("Sheet1").Range("A5").Value = _ 
    Worksheets("Sheet1").Range("A1").Value

And since the issue is more relative to get the specific information from Microsoft Project, I would like to move it to Project forum.

The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us.
Thanks for your understanding.

And if you have any problem about Excel developing, please feel free to reopen a new thread in this forum.

Regards & Fei