CODEWITHSUNDEEP
vbaexcel
Del2me
Del2me

Reputation: 5

For each cell in range, if cell value is not blank then vlookup

I'm struggling to get the below code to function due to Run-time error '1004': Application-define or object-defined error.

Usually when I've encountered this error is was due to sheet protection, I've ensured sheets are unprotected thus the line at the start of the sub.

I'll outlay the scenario here and the end goal:

Sheet1 = Live Contracts

This sheet contains a table of 6 columns and dynamic number of rows. column 1 contains a contract reference number. Columns 2 - 6 are irrelevant to this.

Sheet 4 = Contract Sums

This sheet contains all contracts, the corresponding department and the value of the contract.

Goal

Create a module which can be called via a userform button.

The module needs to view column A of sheet1 and for each cell -if there is a value- create a vlookup in column G with the following parameters. 

Lookup Value = Cell.offset(0, -6)

Table array = Sheet4.range("A3:C676")

Col_Index_Num = 1

FALSE - Exact match

The module would need to repeat this process for all cells within the range.

Now for what I've produced:

 Worksheets("Live Contracts").Unprotect

Dim rng As range
Dim lastrow As Long
Dim cell As range
Dim contractrange As range

'Find dynamic range
lastrow = Worksheets("Live Contracts").range("A" & Rows.Count).End(xlUp).Row

Set contractrange = Worksheets("Contract Sums").range("A3:C676")
Set rng = Worksheets("Live Contracts").range("A2:A" & lastrow)

For Each cell In rng
'If cell does not equal blank then for each cell in column A, offset to column G.
    If cell.Value <> "" Then

    'In column G, vlookup column A cell value in contractrange's column C, only return exact match
        cell.Offset(0, 6).Value = Application.VLookup(cell.Offset(0, -6), contractrange, 1, False)

        'In column H, vlookup column A cell value in contractrange's column A, only return exact match
        cell.Offset(0, 7).Value = Application.VLookup(cell.Offset(0, -7), contractrange, 3, False)
    End If
    'Repeat for all cells in range
Next cell


End Sub

The first line beginning with cell.offset is being highlighted when debugging

P.S I'm relatively new to VBA, apologies for poor code!

Upvotes: 0

Views: 2537

Answers (1)

Jarom
Jarom

Reputation: 1077

It looks like you might be mixing up the use of active cells and the Cell that you are using in your loop. The Cell will only change after a full loop iteration. It is not like an active cell that will change after you select a different cell.

So when you use Cell.offset(0,6), the Cell has not changed, so you don't need to try to get back by using Cell.offset(0,-6) in the Vlookup.

Try this instead:

For Each cell In rng
'If cell does not equal blank then for each cell in column A, offset to column G.
    If cell.Value <> "" Then

    'In column G, vlookup column A cell value in contractrange's column C, only return exact match
        cell.Offset(0, 6).Value = Application.VLookup(cell, contractrange, 1, False)

        'In column H, vlookup column A cell value in contractrange's column A, only return exact match
        cell.Offset(0, 7).Value = Application.VLookup(cell, contractrange, 3, False)
    End If
    'Repeat for all cells in range
Next cell


End Sub

Upvotes: 1

Related Questions