1

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

Community
  • 1
  • 1
Matthias
  • 123
  • 2
  • 7
  • 19
  • 1
    Rick has given you a solution. Also you are using too many `.Selects` and `.Activates` Would recommend having a look at this link as well http://stackoverflow.com/questions/10714251/excel-macro-avoiding-using-select – Siddharth Rout Dec 18 '12 at 02:37

1 Answers1

1

This might be a shot in the dark but I believe your error is here

PosIdent = "IdSelect" & "/" & Cnt + 1

that should be

PosIdent = Range("IdSelect").Value & "/" & Cnt + 1

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

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
Next Cnt

hope that helps

Update

Try this:

Option Explicit
Public ServCnt As Integer
Sub Main()

Call Count_Line_Items
Call Count_Total_Rows
Call Write_Services

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
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 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
Rick
  • 1,063
  • 8
  • 26
  • Thanks for the answer; it did not fix the main problem but it did make me put the PosIdent into the loop which is a different problem now fixed! – Matthias Dec 18 '12 at 11:43
  • Ok so the other thing that I notice is that you do not define the variable ServCnt this means that when you run your loop it will only run once. This does not solve the issue of the error message but will still need to be fixed. – Rick Dec 18 '12 at 19:00
  • One more thing that I should have picked up on before is that you do not need to increment Cnt, the loop will do that for you. – Rick Dec 18 '12 at 19:25
  • Thanks for your comments - I defined ServCnt in the first procedure and thought I could use it in this procedure as it is public by default? I also tried to pass it as an argument to the current procedure but the procedure would not run anymore: When I clicked run it asked me to choose from one of the other two procedures, so my conclusion was that this was not the right way to go? Thanks. – Matthias Dec 19 '12 at 00:01
  • If your sub requires an argument you will no longer be able to debug it as it will not have the required argument, you will have to call it from another procedure and give it the argument or you could store it as a public variable - under your option explicit line add "Public ServCnt as Integer" this will enable your write services routine to reference the variable however there is no guarantee that the value has been set by the first procedure – Rick Dec 19 '12 at 00:31
  • Ok I have now created a new sub called Main which calls the others and passed ServCnt as argument to the last sub. Results see above. – Matthias Dec 19 '12 at 19:35
  • Good attempt but the issue was in your Main Sub, you were declaring and referencing ServCnt but you were not defining it, you were then calling Count_Line_Items which would then declare the variable again and define it but the value of the variable does not flow back to the Main Sub. – Rick Dec 19 '12 at 19:56
  • Ok, so if I define ServCnt in Main, that does not solve my problem either I assume? Since you mention that the changes in value to the variable applied by Count_Line_Items needs to flow back to Main? How do I do that last bit? – Matthias Dec 19 '12 at 21:31
  • See my updated code, I have declared it as a global variable, you will just need to make sure that you call the count line code first to define the variable – Rick Dec 19 '12 at 21:55
  • Ok it finally worked: in addition to your change I discovered that in the Count_Total_Rows I needed to activate the Invoice sheet before selecting the range "Print_Area" - I noticed because I kept getting errors depending on which sheet was active when I ran Main! Many thanks for all your help with this! – Matthias Dec 20 '12 at 16:15