My VBA does not work!!

[Robert Heuveling]

In my following VBA (in ms project) i open a excel file and with a vlookup i
search for info. but not every vlookup will end up with a result thus it will
give error 1004.
so far not a problem,

here is the part of the code which handles the error

Set test = Nothing
On Error Resume Next
test =
xlApp.ActiveWorkbook.Application.WorksheetFunction.VLookup(TaskAct,
Sheets("test1").Range("C:G"), 5, False)
If Err.Number = 1004 Then
TempPercent = 0
ProjectTaskT.Notes = "activiteit niet gevonden"
Else
TempPercent =
xlApp.ActiveWorkbook.Application.WorksheetFunction.VLookup(TaskAct,
Sheets("test1").Range("C:G"), 5, False)
End If

When i run the macro for the first time it will do the trick. but the 2nd
time it gives the result TempPercent = 0 every time also when there is a
match.
It looks like that the Err.Number hangs..

Does anybody have a clue how to solve this problem.

greetings

Robert Heuveling


Here is the complete code:


Sub Update_Percentage2()
' Deze macro haalt de technische voortgangscijfers uit een excel file en
plaatst deze in Fysiek percentage voltooid.
Dim xlApp As Excel.Application
Dim FilesParent, ProjectTasks As Tasks
Dim FileT, ProjectTaskT As Task
Dim Proj As MSProject.Application
Dim SpreadsheetName, XLSNameWithPath, TaskAct, Perccheck As String
Dim TempPercent As Integer
Dim test As Variant

Set Proj = GetObject(, "MSProject.Application")

' Hier moet de filenaam van de excelfile worden gegeven
XLSNameWithPath = InputBox("geef de filename (+ pad) van de update file")
'
' Hier wordt de excel file geopend
Set xlApp = New Excel.Application
xlApp.Visible = True
xlApp.Workbooks.Open FileName:=XLSNameWithPath

' Hier wordt per activiteit gekeken of deze bestaat in excel en plaatst
vervolgens de percentage in het projectbestand
For Each ProjectTaskT In Proj.Application.ActiveProject.Tasks
' Gebruikt VLookUp (Verticaal zoeken om het % techn complete te vinden
If ProjectTaskT.Summary = False Then
TaskAct = ProjectTaskT.Text2
Set test = Nothing
On Error Resume Next
test =
xlApp.ActiveWorkbook.Application.WorksheetFunction.VLookup(TaskAct,
Sheets("test1").Range("C:G"), 5, False)
If Err.Number = 1004 Then
TempPercent = 0
ProjectTaskT.Notes = "activiteit niet gevonden"
Else
TempPercent =
xlApp.ActiveWorkbook.Application.WorksheetFunction.VLookup(TaskAct,
Sheets("test1").Range("C:G"), 5, False)
End If
ProjectTaskT.PhysicalPercentComplete = TempPercent
End If

Next ProjectTaskT

' Sluit MS Excel
xlApp.Visible = False
xlApp.Workbooks.Close
xlApp.Quit
Set xlApp = Nothing
End Sub

 

[papou]

Hi Robert
You may consider clearing the error in your error handling.
Err.Clear

HTH
Cordially
Pascal

 

[Robert Heuveling]

I tried that but it didn't correct the problem

Hi Robert
You may consider clearing the error in your error handling.
Err.Clear

HTH
Cordially
Pascal

 

[NickHK]

Robert,
You have too many and too few objects here:
test = xlApp.ActiveWorkbook.Application.WorksheetFunction.VLookup(TaskAct,
Sheets("test1").Range("C:G"), 5, False)

xlApp.WorksheetFunction.VLookup is sufficient.
Also, using automation, always make sure all your object reference go
through xlApp so you avoid unqualified references. So you have something
like:

Dim WB as workbook
Dim WS as worksheet
Dim test as variant

set wb=xlapp.workbooks.open(<Path&Filename>)
set ws=wb.worksheets("test1")
'Not sure what TaskAct refers to
test = xlApp.WorksheetFunction.VLookup(<TaskAct>, WS.Range("C:G"), 5, False)
'etc

NickHK

 

[Robert Heuveling]

I still don't know why but this change did the trick. and the code does look
a lot cleaner now.

Many thanks...

Greetings

Robert Heuveling