Please help with VBA Code Error
Hello,
I'm just a beginner in VBA and I have copied this code into my Excel workbook to export data to MS Project. I got this error when trying to execute it. PLEASE HELP HELP!
Error Number: 1004
Error Desc: Method 'Range' of object '_Global' failed
Row: 0
VBA Code:
Sub Excel_Export_to_Project()
On Error GoTo errortrap
'Project
Dim appProj As Object
Dim proj As Object
Dim t As Object
Dim taskID As Integer
'Excel
Dim wb As Excel.Workbook
'Dim exportRange As Excel.Range
Dim ProjNameRange As Excel.Range
Dim ProjIDRange As Excel.Range
Dim ProjDurRange As Excel.Range
Dim ProjStartRange As Excel.Range
Dim ProjPredRange As Excel.Range
Dim ProjOLRange As Excel.Range
Dim ContLoop As Boolean
Dim blanks As Integer
Dim Row As Integer
'Set the excel workbook and export range
Set wb = ActiveWorkbook
Set ProjNameRange = Range("ProjName")
Set ProjIDRange = Range("ProjID")
Set ProjDurRange = Range("ProjDur")
Set ProjStartRange = Range("ProjStart")
Set ProjPredRange = Range("ProjPred")
Set ProjOLRange = Range("ProjOL")
'Set exportRange = wb.Worksheets("color bars SER").Range("projStartExport")
'Connect to open Project app and file
Set appProj = CreateObject("MSProject.Application")
Set proj = appProj.ActiveProject
If MsgBox("Overwrite existing Project file data (" & proj.Name & ")?", vbYesNo, "Overwrite Data") = vbYes Then
ContLoop = True
Row = 1
'Remove the existing tasks
If proj.Tasks.Count > 0 Then
For Each t In proj.Tasks
Debug.Print t.Name
t.Delete
Next
End If
'Add tasks from excel file
While ProjIDRange.Offset(Row).Value <> "" 'Look for blank project id to find end of export list
If ProjNameRange.Offset(Row).Value <> "" Then
Set t = proj.Tasks.Add(ProjNameRange.Offset(Row).Value)
Else
Set t = proj.Tasks.Add("Empty")
End If
t.Start = Format(ProjStartRange.Offset(Row).Value, "mm/dd/yyyy")
t.Duration = ProjDurRange.Offset(Row).Value & " mons"
If ProjPredRange.Offset(Row).Value <> "" Then
t.Predecessors = ProjPredRange.Offset(Row).Value
End If
If ProjOLRange.Offset(Row).Value <> "" Then
t.OutlineLevel = ProjOLRange.Offset(Row).Value
End If
taskID = t.ID
Row = Row + 1
Wend
'activate ms project
proj.Activate
End If
Exit Sub
errortrap:
Select Case Err.Number
Case 424
MsgBox ("You must have a project file open")
Case Else
MsgBox ("(" & Err.Number & ") " & Err.Description & Chr(10) & "Row: " & Row)
Debug.Print "Error Number:", Err.Number
Debug.Print "Error Desc:", Err.Description
Debug.Print "Row:", Row
End Select
End Sub
---
Thank you so much!
Angela
