|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
VBA: Attempting to loop through all resources, apply a filter and paste the results into Excel
I am attempting to produce some VBA in MS project to:
Open a new instance of Excel Set up some columns Apply a filter in MSP and copy the contents Paste into the opened Excel file Save the Excel file Close the excel file This is all being done for each resource in the project plan (there are three at the moment). I have been using some code I produced a very long time ago which didn't have to iterate and open and close many Excel files and I wonder if this is what is giving me trouble. At the moment I have three key issues; The paste command doesn't work. I have tried many types of paste and they either result in a picture including the Gantt chart being pasted in or nothing happens. The middle of three resources seems to be missed out - I suspect some error is happening which results in the loop being abandoned. I get multiple errors: Error: Invalid Procedure call or Argument Error: Object variable or With clock variable not set. I know that the table is being copied into the clipboard as I can pause the code and manually paste it into Excel with <ctrl><v>. I have tried multiple methods of paste as you can see in the section titled "this is where the problem is" and the result of each has been recorded alongside; it is either nothing visible happens or I get a picture being pasted in! If anyone can help me out I would be grateful My code: Code:
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 |
#2
|
|||
|
|||
Hi Miles,
I did a quick test and this worked for me. I do have a newer version of Office, so I don't know if it will work for you. You can change the range to wherever you need it. I didn't specify the size of my table, just a simple paste to start at the cell I chose for my range: Code:
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 Home | Mad Schedules With Minerva Goree YouTube: mad schedules - YouTube |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Copy Paste Special Loop to End of Col A | ChrisOK | Excel Programming | 8 | 01-19-2020 10:20 PM |
Filter not returning all relevant results | hnhorner | Excel | 3 | 07-12-2015 05:33 PM |
Loop through files and Copy Table Row and Paste into Different Document | spiderman1369 | Word VBA | 2 | 10-15-2014 08:30 AM |
Formatting- Apply changes to highlighted text results in same change to other text | sential | Word | 6 | 01-10-2014 03:22 PM |
Apply filter with VBA | bobsawyer7 | Outlook | 0 | 03-12-2012 04:02 AM |