Export of Excel data into Project works when text is typed, but doesn't when copied from another worksheet RRS feed

  • Question

  • Hello! I have an Excel worksheet which contains filtered data. I've written a macro within Excel which copies the filtered data into a second worksheet and creates a new Project file and copies the task name, start date, finish etc. across. The data being copied across (second worksheet) is standard text without any formulas. When attempting to import the data in Project, the code fails and results in Run-time error 1101 (The argument is not valid). However, when I manually type the task name in, exactly as per the copied across version and test the code, it works without fault. Below is a sample of the code I'm working with. Any suggestions to resolve? Thank you.

    Option Explicit
    Sub Add_Data_Project()
        Dim wbBook As Workbook
        Dim ProjTasks As Range
        Dim src As Worksheet, tgt As Worksheet
        Dim firstRow As Long, lastRow As Long, TaskIDCol As Long, TaskCol As Long, SDCol As Long, FDCol As Long, TaskStsCol As Long, ResCol As Long, TaskLinksCol As Long, LevelCol As Long, BRAGCol As Long
        Dim PDfirstRow As Long, PDTaskIDCol As Long, PDTaskCol As Long, PDSDCol As Long, PDFDCol As Long, PDTaskStsCol As Long, PDResCol As Long, PDTaskLinksCol As Long, PDLevelCol As Long, PDBRAGCol As Long
        Dim copyRange1 As Range, copyRange2 As Range, copyRange3 As Range, copyRange4 As Range, copyRange5 As Range, copyRange6 As Range, copyRange7 As Range, copyRange8 As Range, copyRange9 As Range
        Dim ClearRng As Range, PerCentChg As Range
        Dim c As Object
        Call sbUnProtectSheet
        Set wbBook = ThisWorkbook
        Set src = ActiveSheet
        Set tgt = wbBook.Worksheets("PROJECT_DATA")
        firstRow = src.Range("TASK_ID").Offset(1, 0).Row
        lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
        TaskIDCol = src.Range("TASK_ID").Column
        TaskCol = src.Range("CONCATENATE").Column
        SDCol = src.Range("START_DATE").Column
        FDCol = src.Range("DUE_DATE").Column
        TaskStsCol = src.Range("TASK_COMP").Column
        ResCol = src.Range("OWNER").Column
        TaskLinksCol = src.Range("LINKS").Column
        LevelCol = src.Range("LEVEL").Column
        BRAGCol = src.Range("STATUS").Column
        Set copyRange1 = src.Range(Cells(firstRow, TaskIDCol), Cells(lastRow, TaskIDCol))
        Set copyRange2 = src.Range(Cells(firstRow, TaskCol), Cells(lastRow, TaskCol))
        Set copyRange3 = src.Range(Cells(firstRow, SDCol), Cells(lastRow, SDCol))
        Set copyRange4 = src.Range(Cells(firstRow, FDCol), Cells(lastRow, FDCol))
        Set copyRange5 = src.Range(Cells(firstRow, TaskStsCol), Cells(lastRow, TaskStsCol))
        Set copyRange6 = src.Range(Cells(firstRow, ResCol), Cells(lastRow, ResCol))
        Set copyRange7 = src.Range(Cells(firstRow, TaskLinksCol), Cells(lastRow, TaskLinksCol))
        Set copyRange8 = src.Range(Cells(firstRow, LevelCol), Cells(lastRow, LevelCol))
        Set copyRange9 = src.Range(Cells(firstRow, BRAGCol), Cells(lastRow, BRAGCol))
        PDfirstRow = tgt.Range("PROJECT_TASKS").Row
        PDTaskIDCol = tgt.Range("PROJ_ID").Column
        PDTaskCol = tgt.Range("TASK_PROJ").Column
        PDSDCol = tgt.Range("START_DATE").Column
        PDFDCol = tgt.Range("FINISH_DATE").Column
        PDTaskStsCol = tgt.Range("TASK_STATUS").Column
        PDResCol = tgt.Range("RESOURCE").Column
        PDTaskLinksCol = tgt.Range("TASK_LINKS").Column
        PDLevelCol = tgt.Range("LEVEL").Column
        PDBRAGCol = tgt.Range("BRAG").Column
        Set ClearRng = tgt.Range(Cells(PDfirstRow, PDTaskIDCol), Cells(10000, PDBRAGCol))
        copyRange1.SpecialCells(xlCellTypeVisible).Copy tgt.Cells(PDfirstRow, PDTaskIDCol)
        copyRange2.SpecialCells(xlCellTypeVisible).Copy tgt.Cells(PDfirstRow, PDTaskCol)
        copyRange3.SpecialCells(xlCellTypeVisible).Copy tgt.Cells(PDfirstRow, PDSDCol)
        copyRange4.SpecialCells(xlCellTypeVisible).Copy tgt.Cells(PDfirstRow, PDFDCol)
        copyRange5.SpecialCells(xlCellTypeVisible).Copy tgt.Cells(PDfirstRow, PDTaskStsCol)
        copyRange6.SpecialCells(xlCellTypeVisible).Copy tgt.Cells(PDfirstRow, PDResCol)
        copyRange7.SpecialCells(xlCellTypeVisible).Copy tgt.Cells(PDfirstRow, PDTaskLinksCol)
        copyRange8.SpecialCells(xlCellTypeVisible).Copy tgt.Cells(PDfirstRow, PDLevelCol)
        copyRange9.SpecialCells(xlCellTypeVisible).Copy tgt.Cells(PDfirstRow, PDBRAGCol)
        Set PerCentChg = tgt.Range(Cells(PDfirstRow, PDTaskStsCol), Cells(tgt.Cells(10000, Range("tASK_status").Column).End(xlUp).Row, PDTaskStsCol))
        For Each c In PerCentChg
            c = c * 100
            c.NumberFormat = "General"
        Next c
        Dim vaTeammembers As Variant, vaTasks As Variant, vaTaskComp As Variant, vaLevel As Variant
        Dim vaStartDates As Variant, vaTime As Variant, vaPre As Variant, vaStatus As Variant
        Dim lnStart As Long, lnCounter As Long
        'Populate the variables with values from the worksheet.
        With tgt
            lnStart = .Range("C65536").End(xlUp).Row
            vaTasks = .Range("C2:C" & lnStart).Value
            vaStartDates = .Range("D2:D" & lnStart).Value
            vaTime = .Range("E2:E" & lnStart).Value
            vaTaskComp = .Range("F2:F" & lnStart).Value
            vaTeammembers = .Range("G2:G" & lnStart).Value
            vaPre = .Range("H2:H" & lnStart).Value
            vaLevel = .Range("I2:I" & lnStart).Value
            vaStatus = .Range("J2:J" & lnStart).Value
        End With
        'Instantiate and open MS Project and the project.
        Dim prApp As MSProject.Application
        Dim prProject As MSProject.Project
        Dim prTask As MSProject.task
        Dim prResource As MSProject.Resource
        Dim bFlagTask As Boolean
        Dim bFlagResource As Boolean
        Set prApp = New MSProject.Application
        Dim objFSO As Variant
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        ' First parameter: original location\file
        ' Second parameter: new location\file
        Dim dirLoc As String
        Dim NewFileName As String
        Dim NewFileName2 As String
        Dim a As Integer
        Dim p As Integer
        dirLoc = ActiveWorkbook.Path
        p = 1
        Do Until p = 0
            NewFileName = InputBox("Enter name for MS Project file:", "Task Management")
            If Len(NewFileName) = 0 Then
                MsgBox "Please enter a valid name!", vbCritical
                Exit Sub
                NewFileName = dirLoc & "\" & NewFileName & ".mpp"
            End If
            If Not Dir(NewFileName, vbDirectory) = vbNullString Then
                MsgBox "File name already exists", vbExclamation
                p = 0
            End If
        objFSO.CopyFile dirLoc & "\DO_NOT_DELETE.mpp", NewFileName
        prApp.FileOpen (NewFileName)
        Set prProject = prApp.ActiveProject
        'Add task and other wanted information to the project.
        With prProject
            For lnCounter = 1 To UBound(vaTasks)
                bFlagResource = False
                'Loop through the collection of present resources and check if a resource exists or not.
                For Each prResource In prProject.Resources
                    On Error Resume Next
                    If prResource.Name = vaTeammembers(lnCounter, 1) Then bFlagResource = True
                Next prResource
                'Add the resource to the project and add a rate to it.
                If bFlagResource = False Then
                    .Resources.Add vaTeammembers(lnCounter, 1)
                    With .Resources(vaTeammembers(lnCounter, 1))
                        .StandardRate = 100
                        .OvertimeRate = 100 * 1.5
                    End With
                End If
                .Tasks.Add vaTasks(lnCounter, 1) '**POINT AT WHICH CODE FAILS!**
                    With .Tasks(vaTasks(lnCounter, 1))
                        .Name = vaTasks(lnCounter, 1)
                        .ResourceNames = vaTeammembers(lnCounter, 1)
                        .Start = vaStartDates(lnCounter, 1)
                        .Finish = vaTime(lnCounter, 1)
                        .PercentComplete = vaTaskComp(lnCounter, 1)
                        .Predecessors = vaPre(lnCounter, 1)
                        '.OutlineLevel = vaLevel(lnCounter, 1)
                        '.SetField FieldNameToFieldConstant("BRAG"), vaStatus(lnCounter, 1)
                    End With
            Next lnCounter
        End With
        'Save the project and close MS Project.
        With prApp
        End With
        MsgBox "The project has successfully been updated!", vbInformation
        'Release objects from memory.
        Set prResource = Nothing: Set prTask = Nothing
        Set prProject = Nothing: Set prApp = Nothing
    End Sub

    Sunday, August 7, 2016 9:02 AM

All replies

  • llOllOll,

    Your macro is rather complex and without having the benefit of your Excel workbook, it makes troubleshooting more difficult.

    However, on a quick look it appears that at the point of failure you are trying to add a task using the vaTask variable. There are two arguments for that variable which indicates it is an array but it is not defined as an array, it is simply defined as a type variant. The same thing also applies to several other variables and it's not clear why you don't get an error earlier in the code but at least it's a place to start.

    Hope this helps.


    Sunday, August 7, 2016 4:16 PM
  • Thank you for your assistance John.

    In an attempt to isolate the problem, I've simplified the above code and worksheet however I've failed to replicate the error (i.e. the simplified code/worksheet works as required). I'll re-add the detail in systematically and resolve the issue that way.

    Monday, August 8, 2016 9:24 AM
  • llOllOllOll,

    You're welcome and thanks for the feedback.

    The approach you are taking is exactly what I would do. If you narrow it down but still have an issue, let us know and we'll help you figure it out.

    As a side suggestion, you use a row count technique to find out how many entries are on your worksheet. You might want to look into the Worksheet.UsedRange Property, I've found it very useful for bounding a worksheet.


    Monday, August 8, 2016 1:10 PM