Array Lookup on separate sheet

[bhalbach]

I'm trying to do a lookup on a separate sheet of the same workbook.

On sheet "Expenses" I want to lookup the data in column "E" for each row and match it to sheet "Accounting Column "A". When a match is found in on sheet "Accounting column A", return the value to sheet "Expenses Column H"

Then next same for all rows.

I am trying to learn this but its a slow process...this is the code I have thus far with no success. I am probably out to lunch on it. It is a hack job of some code I had someone assist me with for a bit different lookup.

Can someone assist me please?


Sub fillGL()

Dim lastRow As Long
Set lastRow = .Cells(Rows.Count, "A").End(xlUp).Row

With Worksheets("Accounting")
datar = .range(.Cells(1, 1), .Cells(lastRow, 3)) ' pick all the data in columns A to C of Accounting sheet from row 1 to the last row
End With


With Worksheets("Expenses")
inarr = .range(.Cells(2, 1), .Cells(lastRow, 19)) ' pick up the values to look up "Expenses column E"
outarr = .range(.Cells(2, 1), .Cells(lastRow, 19)) ' define the output array
For i = 1 To UBound(inarr, 1) ' loop through each lookup value

For j = 1 To lastRow ' loop through each row of the Accounting data to find a match
If inarr(i, 3) = datar(j, 1) Then ' check for a match
outarr(i, 6) = datar(j, 3) ' copy data to output when matched

Exit For ' exit the inner loop because we have matched the look up

Next j

Next i


End With

End Sub

 

[bhalbach]

No Luck...

Nothing is being written back to the "Expenses column E"

 

[offthelip]

See comment #3 same problem

 

[bhalbach]

See comment #3 same problem

I assume you mean adding this statement to write the data to Expenses column E>>>>.range(.Cells(2, 1), .Cells(lastRow, 19)) = outarr

Placed before the last "End With"

It adds #N/A to the rows up tot row 45 on all columns A to S

 

[offthelip]

change the lastrow to lastrowx on that line

 

[bhalbach]

No Joy.

Nothing is written to "Expenses column E"

Sub fillGL()

Dim lastRow As Long

With Worksheets("Accounting")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
datar = .range(.Cells(1, 1), .Cells(lastRow, 3)) ' pick all the data in columns A to C of Accounting sheet from row 1 to the last row
End With


With Worksheets("Expenses")
lastRowx = .Cells(Rows.Count, "A").End(xlUp).Row ' added this line because from your comment I think the last row on expense sheet is different to the accounting sheets
inarr = .range(.Cells(2, 1), .Cells(lastRowx, 19)) ' pick up the values to look up "Expenses column E"
outarr = .range(.Cells(2, 1), .Cells(lastRowx, 19)) ' define the output array . actually these two arrays are the same you only actually need one of them
For i = 1 To UBound(inarr, 1) ' loop through each lookup value

For j = 1 To lastRow ' loop through each row of the Accounting data to find a match
If UCase(inarr(i, 3)) = UCase(datar(j, 1)) Then ' check for a match
outarr(i, 6) = datar(j, 3) ' copy data to output when matched

Exit For ' exit the inner loop because we have matched the look up
End If
Next j

Next i


.range(.Cells(2, 1), .Cells(lastRowx, 19)) = outarr

End With

 

[bhalbach]

change the lastrow to lastrowx on that line

I think I got it...yay

Thanks for all your help...I REALLY appreciate it!!!

had to change this...

If UCase(inarr(i, 5)) = UCase(datar(j, 1)) Then ' changed from "If UCase(inarr(i, 3)) = UCase(datar(j, 1)) Then"
outarr(i, 8) = datar(j, 3) ' copy data to output when matched ' changed from "outarr(i, 6) = datar(j, 3)"

Sub fillGL()

Dim LastRow As Long

With Worksheets("Accounting")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
datar = .range(.Cells(1, 1), .Cells(LastRow, 3)) ' pick all the data in columns A to C of Accounting sheet from row 1 to the last row
End With


With Worksheets("Expenses")
LastrowX = .Cells(Rows.Count, "A").End(xlUp).Row ' added this line because from your comment I think the last row on expense sheet is different to the accounting sheets
inarr = .range(.Cells(2, 1), .Cells(LastrowX, 19)) ' pick up the values to look up "Expenses column E"
outarr = .range(.Cells(2, 1), .Cells(LastrowX, 19)) ' define the output array . actually these two arrays are the same you only actually need one of them
For i = 1 To UBound(inarr, 1) ' loop through each lookup value

For j = 1 To LastRow ' loop through each row of the Accounting data to find a match
If UCase(inarr(i, 5)) = UCase(datar(j, 1)) Then ' check for a match
outarr(i, 8) = datar(j, 3) ' copy data to output when matched

Exit For ' exit the inner loop because we have matched the look up
End If
Next j

Next i


.range(.Cells(2, 1), .Cells(LastrowX, 19)) = outarr

End With

End Sub

 

[offthelip]

Great well done, you have managed to debug the problems yourself, so it means you are really looking at the code. So you can use this technique in the future. I never use Index, Match or Vlookup in Vba it is always faster and more flexible to use this technique.

 

[bhalbach]

Great well done, you have managed to debug the problems yourself, so it means you are really looking at the code. So you can use this technique in the future. I never use Index, Match or Vlookup in Vba it is always faster and more flexible to use this technique.

Thanks for the help. I will continue using this technique since I think it finally makes sense. ??

 

[bhalbach]

Great well done, you have managed to debug the problems yourself, so it means you are really looking at the code. So you can use this technique in the future. I never use Index, Match or Vlookup in Vba it is always faster and more flexible to use this technique.

I have one more question if you don't mind?

This code works great, thanks to you. But there is one thing that I would like...

I am calling this from a worksheet change event and if I manually fill one of the fields that the array had a blank, on the "Expenses" sheet...it fires the macor again and overwrites the data I put in the blank cell.
Can the code be tweaked so it doesn't overwrite the cell, if the array is blank?

Sub fillExpensesLookups()

Dim LastRow As Long

With Worksheets("Accounting")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
datar = .range(.Cells(1, 1), .Cells(LastRow, 7)) ' pick all the data in columns A to C of Accounting sheet from row 1 to the last row
End With

With Worksheets("Expenses")
LastrowX = .Cells(Rows.Count, "A").End(xlUp).Row
inarr = .range(.Cells(2, 1), .Cells(LastrowX, 19)) ' pick up the values to look up "Expenses column E"
outarr = .range(.Cells(2, 1), .Cells(LastrowX, 19)) ' define the output array . actually these two arrays are the same you only actually need one of them
For i = 1 To UBound(inarr, 1) ' loop through each lookup value
For j = 1 To LastRow ' loop through each row of the Accounting data to find a match
If UCase(inarr(i, 5)) = UCase(datar(j, 1)) Then ' check for a match
outarr(i, 8) = datar(j, 2) ' copy data to output when matched
outarr(i, 9) = datar(j, 3)
outarr(i, 11) = datar(j, 5)
outarr(i, 6) = datar(j, 6)
Exit For ' exit the inner loop because we have matched the look up
End If
Next j
Next i
.range(.Cells(2, 1), .Cells(LastrowX, 19)) = outarr

End With
End Sub

 

[offthelip]

one of the fields that the array had a blank,

I need more details, you need be much more specific about which column were you writing data into and which column had a blank in it, and what you actually want to achieve.