Sub emailFilteredResources()
 Dim MyXL As Object
 Dim Version As String
 Dim MSP_name As String
 Dim finish As Date
 Dim name As String
 Dim email As String
 
    
    On Error Resume Next                ' keep going on an error
    
'message box asking for date for next friday
    finish = InputBox("Please enter the date for next Friday", "Date entry", Int(Now() + 8)) 'assumes that we will be running this on Thursday

'display all tasks
    OutlineShowAllTasks
    
    SelectBeginning                     ' restart from the beginning
    
For Each Resource In ActiveProject.Resources
    If Resource.Work > 0 Then
    
    'setup and apply filter for each resource
    FilterEdit name:="filter4people", TaskFilter:=True, Create:=True, OverwriteExisting:=True, FieldName:="Start", Test:="is less than or equal to", Value:=finish, ShowInMenu:=True, ShowSummaryTasks:=True
    FilterEdit name:="filter4people", TaskFilter:=True, FieldName:="", NewFieldName:="% Complete", Test:="is less than", Value:="100%", Operation:="And", ShowSummaryTasks:=True
    FilterEdit name:="filter4people", TaskFilter:=True, FieldName:="", NewFieldName:="Resource names", Test:="contains", Value:=Resource.name, Operation:="And", ShowSummaryTasks:=True
        
    FilterApply "filter4people" ' apply the filter
        If (Err.Number) Then            ' saw an error applying filter
            MsgBox "ERROR: " & Err.Description
            Err.Clear                   ' clear out the error
            GoTo NextResource           ' jump to the next resource
        End If
    End If
'gather date from resource (name, email) as variables to be called later
    name = Resource.name
    email = Resource.EMailAddress

'Copy data from the view
    SelectAll
    EditCopy
    rows = CStr(ActiveSelection.Tasks.Count)
    Debug.Print name
    Debug.Print email
    
'setup excel file

 
    'Set the file version using time stamp.  Would be nice to have a-z rather than h:m:s but that can follow
    Version = Format(Now, "yyyy-mmm-dd hh-mm-ss")
 
    'find the current project's path and set the file name for the excel file to be produced
    myFilePath = ActiveProject.Path
    myfilename = myFilePath & "\" & name & " " & Version & ".xlsx"
    
    Set MyXL = CreateObject("Excel.Application")
    MyXL.Workbooks.Add
 
    'MyXL.workbooks.Add.Name = "Exceptions.xlsx"
    MyXL.Visible = True

    MyXL.ActiveWorkbook.Worksheets.Add.name = "Weekly look ahead"
    MyXL.ActiveWorkbook.Worksheets("Weekly look ahead").Activate

    Set xlrange = MyXL.ActiveSheet.Range("A1")
'set the page titles in Excel
    xlrange.Range("o1") = "Start"
    xlrange.Range("o2") = "Finish"
    xlrange.Range("p1") = finish - 7
    xlrange.Range("p2") = finish
    xlrange.Range("r1") = "key"
    xlrange.Range("r2") = "Late"
    xlrange.Range("r3") = "Finishing this week"
    xlrange.Range("r4") = "Starting this week"
    xlrange.Range("r5") = "In play this week"
'Set formats for colour key
    xlrange.Range("R2").Font.ColorIndex = 2
    xlrange.Range("r2").Interior.ColorIndex = 3
    xlrange.Range("r3").Interior.ColorIndex = 45
    xlrange.Range("r4").Interior.ColorIndex = 43
    xlrange.Range("r5").Interior.ColorIndex = 15
         
'paste in values to excel file  THIS IS THE ISSUE!!
    'xlrange.Range("a1").Paste '- nothing
    'ActiveSheet.Paste Destination:=xlrange.Range("A1:g" & rows + 1) '- nothing
    'xlrange.Range("A1:g" & rows + 1).PasteSpecial Paste:=xlpastevalues '- paste picture
    'xlrange.Range("A:G").PasteSpecial xlPasteValues '- paste picture
    'xlrange.Range("A1:g" & rows + 1).Paste '- nothing pastes
    xlrange.Select
    ActiveSheet.Paste '-nothing again :(
    
'put conditional formatting in place in excel
    
'set column widths
    With MyXL.ActiveWorkbook.Worksheets("Weekly look ahead")
        .Columns("A:R").AutoFit
    End With
 
    xlrange.Columns("A:A").ColumnWidth = 100
    xlrange.Columns("A:A").EntireColumn.AutoFit
    With xlrange.Range("a1:G" & row + 1)
        .WrapText = True
        .EntireRow.AutoFit
    End With
    
'save excel file
    MyXL.ActiveWorkbook.SaveAs myfilename
    MyXL.ActiveWorkbook.Close
    MyXL.Quit
    Set MyXL = Nothing
    
'send excel file
    
'shift focus back to MS Project
    AppActivate "Microsoft Project"
    
NextResource:
    Next Resource
    
    FilterApply name:="All Tasks"       ' apply the filter

End Sub

Sub test()

    'Select all data and copy
    Application.SelectAll
    Application.EditCopy


    ' Excel - setup
    Set xlApp = GetObject(, "Excel.application")
    
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    
    ' Excel - create a new workbook
    xlApp.Visible = True
    xlApp.Workbooks.Add
    
    ' Excel - create column headings
    Set xlRange = xlApp.Range("A1")
    
    xlRange.PasteSpecial Paste:=xlPasteValues

End Sub