I know that a similar problem was already discussed here: Why is VLookup in VBA failing with runtime error 1004?
but does not seem to solve my problem. A quick explanation of what I want to do here – this is my first VBA post so if there are any issues with clarity of question etc, please let me know.
I am trying to build an invoice sheet which builds an invoice based on
- Project number (in this case 1)
- Data set of all project data
Each project activity is shown as a separate line item and is identified by a unique identifier, consisting of the project number and line item number (so for the third line item in project one it would be “1/3”). The identifier is formatted as a string. All input data is on a worksheet called “Inputs”.
The second sheet is the actual invoice sheet called “Invoice”. The idea is to automatically get the right number of blank rows depending on the number of line items for each project (still working on this part) and also to fill the form automatically. This last part is the one that produces the error when I try to run a vlookup in line 80: The error message is
Unable to get the Vlookup property of the WorksheetFunction class.
I am wondering whether this is caused by the lookup value (the identifier) because I have not created it properly? I have looked at the solutions so far discussed on here but am unable to find the answer 🙁
Thanks in advance for your help! Code below:
Option Explicit
Sub Count_Line_Items()
'Counts the number of line items of a consulting project to determine the space needed on the invoice form
Dim Cell As Range
Dim PosCnt As Integer
Dim ServCnt As Integer
Dim ExpCnt As Integer
PosCnt = 0
ServCnt = 0
ExpCnt = 0
'Counting all project positions for the chosen project number
For Each Cell In Range("ProjectList")
If Cell.Value = Range("IdSelect") Then
PosCnt = PosCnt + 1
End If
Next Cell
MsgBox "Total number of line items: " & PosCnt
'Counting all positions of that project that are consulting services
For Each Cell In Range("ProjectList")
If Cell.Value = Range("IdSelect").Value And Cell.Offset(0, 3).Value = "Service" Then
ServCnt = ServCnt + 1
End If
Next Cell
MsgBox "Total number of consulting services: " & ServCnt
'Calculating number of expense items
ExpCnt = PosCnt - ServCnt
MsgBox "Total number of expenses: " & ExpCnt
End Sub
Sub Count_Total_Rows()
Dim Current_RowCnt As Integer
Dim Target_RowCnt As Integer
Dim Diff_Rows As Integer
Target_RowCnt = 62
'Counting the rows in the print area and calculating difference to target
Range("Print_Area").Select
Current_RowCnt = Selection.Rows.Count
Diff_Rows = Target_RowCnt - Current_RowCnt
If Diff_Rows > 0 Then
MsgBox "We need to add " & Diff_Rows & " rows!"
ElseIf Diff_Rows < 0 Then
MsgBox "We need to delete " & -Diff_Rows & " rows!"
Else
MsgBox "Nothing needs to be done; all good!"
End If
End Sub
Sub Write_Services()
'Looks up services on data sheet and writes them to invoice sheet
Dim Cnt As Integer
Dim ServCnt As Integer
Dim PosIdent As String
Dim Data As Range
Cnt = 0
'Building position identifier
PosIdent = "IdSelect" & "/" & Cnt + 1
Sheets("Input").Select
ActiveSheet.Range("D26:AD151").Select
Set Data = Selection
Sheets("Invoice").Select
ActiveSheet.Range("Service_Title").Offset(1, 0).Activate
'There is still an issue with the counter (line number won't increment by 1 if cnt range is incremented by 1
For Cnt = 0 To ServCnt + 1
ActiveCell.Value = Application.WorksheetFunction.VLookup(PosIdent, Data, 15, False)
ActiveCell.Offset(1, 0).Activate
Cnt = Cnt + 1
Next Cnt
End Sub
Update: I have now changed the code in the last procedure to:
Sub Write_Services()
'Looks up services on data sheet and writes them to invoice sheet
Dim Cnt As Integer
Dim ServCnt As Integer
Dim PosIdent As String
Dim Data As Range
Cnt = 0
'Building position identifier
Sheets("Input").Select
ActiveSheet.Range("D26:AD151").Select
Set Data = Selection
Sheets("Invoice").Select
ActiveSheet.Range("Service_Title").Offset(1, 0).Activate
'There is still an issue with the counter (line number won't increment by 1 if cnt range is incremented by 1
For Cnt = 0 To ServCnt + 1
PosIdent = Range("IdSelect").Value & "/" & Cnt + 1
ActiveCell.Value = Application.WorksheetFunction.VLookup(PosIdent, Data, 15, False)
ActiveCell.Offset(1, 0).Activate
Cnt = Cnt + 1
Next Cnt
End Sub
However the error message is still the same. Thanks for the improvement on the code (it did fix the issue that PosIdent was not updated by the loop) – any other ideas?
Update No. 2:
I have now updated my code based on the helpful answers / comments I received to far (big thanks!) and now it creates a new error message (not sure whether the old one is solved now as the new one occurs earlier in the code in line 59). The new error is “1004: Method ‘Range’ of object ‘_GLobal’ failed. I have really no idea what triggered it since I just created a new sub called Main which calls all the others and then passed the variable ServCnt as an argument to the last sub. Can someone please help?
New code below:
Option Explicit
Sub Main()
Dim ServCnt As Integer
Call Count_Line_Items
Call Count_Total_Rows
Call Write_Services(ServCnt)
End Sub
Sub Count_Line_Items()
'Counts the number of line items of a consulting project to determine the space needed on the invoice form
Dim Cell As Range
Dim PosCnt As Integer
Dim ServCnt As Integer
Dim ExpCnt As Integer
PosCnt = 0
ServCnt = 0
ExpCnt = 0
'Counting all project positions for the chosen project number
For Each Cell In Range("ProjectList")
If Cell.Value = Range("IdSelect") Then
PosCnt = PosCnt + 1
End If
Next Cell
MsgBox "Total number of line items: " & PosCnt
'Counting all positions of that project that are consulting services
For Each Cell In Range("ProjectList")
If Cell.Value = Range("IdSelect").Value And Cell.Offset(0, 3).Value = "Service" Then
ServCnt = ServCnt + 1
End If
Next Cell
MsgBox "Total number of consulting services: " & ServCnt
'Calculating number of expense items
ExpCnt = PosCnt - ServCnt
MsgBox "Total number of expenses: " & ExpCnt
End Sub
Sub Count_Total_Rows()
Dim Current_RowCnt As Integer
Dim Target_RowCnt As Integer
Dim Diff_Rows As Integer
Target_RowCnt = 62
'Counting the rows in the print area and calculating difference to target
Range("Print_Area").Select
Current_RowCnt = Selection.Rows.Count
Diff_Rows = Target_RowCnt - Current_RowCnt
If Diff_Rows > 0 Then
MsgBox "We need to add " & Diff_Rows & " rows!"
ElseIf Diff_Rows < 0 Then
MsgBox "We need to delete " & -Diff_Rows & " rows!"
Else
MsgBox "Nothing needs to be done; all good!"
End If
End Sub
Sub Write_Services(ServCnt)
'Looks up services on data sheet and writes them to invoice sheet
Dim Cnt As Integer
Dim PosIdent As String
Dim Data As Range
Cnt = 0
'Building position identifier
Sheets("Input").Select
ActiveSheet.Range("D26:AD151").Select
Set Data = Selection
PosIdent = Range("IdSelect").Value & "/" & Cnt + 1
Sheets("Invoice").Select
ActiveSheet.Range("Service_Title").Offset(1, 0).Activate
'There is still an issue with the counter (line number won't increment by 1 if cnt range is incremented by 1
For Cnt = 0 To ServCnt + 1
ActiveCell.Value = Application.WorksheetFunction.VLookup(PosIdent, Data, 15, False)
ActiveCell.Offset(1, 0).Activate
Cnt = Cnt + 1
Next Cnt
End Sub
Update 3:
Fixed last bugs – please see comments below for details. Working code below:
Option Explicit
Public ServCnt As Integer
Sub Main()
Call Count_Line_Items
Call Count_Total_Rows
Call Write_Services(ServCnt)
End Sub
Sub Count_Line_Items()
'Counts the number of line items of a consulting project to determine the space needed on the invoice form
Dim Cell As Range
Dim PosCnt As Integer
Dim ExpCnt As Integer
PosCnt = 0
ServCnt = 0
ExpCnt = 0
'Counting all project positions for the chosen project number
For Each Cell In Range("ProjectList")
If Cell.Value = Range("IdSelect") Then
PosCnt = PosCnt + 1
End If
Next Cell
MsgBox "Total number of line items: " & PosCnt
'Counting all positions of that project that are consulting services
For Each Cell In Range("ProjectList")
If Cell.Value = Range("IdSelect").Value And Cell.Offset(0, 3).Value = "Service" Then
ServCnt = ServCnt + 1
End If
Next Cell
MsgBox "Total number of consulting services: " & ServCnt
'Calculating number of expense items
ExpCnt = PosCnt - ServCnt
MsgBox "Total number of expenses: " & ExpCnt
End Sub
Sub Count_Total_Rows()
Dim Current_RowCnt As Integer
Dim Target_RowCnt As Integer
Dim Diff_Rows As Integer
Target_RowCnt = 62
'Counting the rows in the print area and calculating difference to target
Sheets("Invoice").Activate
Range("Print_Area").Select
Current_RowCnt = Selection.Rows.Count
Diff_Rows = Target_RowCnt - Current_RowCnt
If Diff_Rows > 0 Then
MsgBox "We need to add " & Diff_Rows & " rows!"
ElseIf Diff_Rows < 0 Then
MsgBox "We need to delete " & -Diff_Rows & " rows!"
Else
MsgBox "Nothing needs to be done; all good!"
End If
End Sub
Sub Write_Services(ServCnt)
'Looks up services on data sheet and writes them to invoice sheet
Dim Cnt As Integer
Dim PosIdent As String
Dim Data As Range
Cnt = 0
'Building position identifier
Sheets("Input").Select
ActiveSheet.Range("D26:AD151").Select
Set Data = Selection
PosIdent = Range("IdSelect").Value & "/" & Cnt + 1
Sheets("Invoice").Select
ActiveSheet.Range("Service_Title").Offset(1, 0).Activate
'There is still an issue with the counter (line number won't increment by 1 if cnt range is incremented by 1
For Cnt = 0 To ServCnt + 1
ActiveCell.Value = Application.WorksheetFunction.VLookup(PosIdent, Data, 15, False)
ActiveCell.Offset(1, 0).Activate
Cnt = Cnt + 1
Next Cnt
End Sub
This might be a shot in the dark but I believe your error is here
that should be
Also I notice that you only define this once which is why it does not chnage when your range changes, I would move this code here
hope that helps
Update
Try this: