alternative to Vlookup with VBA.

[yango]

Hi guys, i need help. I have a task and i dont want to use vlookup because it makes the process very slow. im looking for a purely VBA code for the task.

here is the code:

Sub get_current_status()


Application.ScreenUpdating = False

Sheets("Sending List").Select

Dim Lastrow1, Lastrow2 As Long
Dim ws1, ws2 As Worksheet
Dim tempVal, tempVal2 As String

Set ws1 = Sheets("Sending List")
Set ws2 = Sheets("P13 D-Chain Status")

Lastrow1 = ws1.Range("B" & Rows.Count).End(xlUp).Row
Lastrow2 = ws2.Range("B" & Rows.Count).End(xlUp).Row

With ws2
.Range("Q2:Q" & Lastrow2).Formula = "=A2&D2"
.Range("R2:R" & Lastrow2).Formula = "=G2"
End With

With ws1
.Range("D2:D" & Lastrow1).Formula = "=VLOOKUP(A2&B2,'P13 D-Chain Status'!Q:R,2,0)"
End With



Application.ScreenUpdating = True

End Sub

Explanation:

Here i combain the values in column A and D in sheet 2. If the values in column A and B of sheet 1 are the same as that in sheet 2, then i copy the correspond values in column G in sheet 2 to column D in sheet 1.
Hope its clear . Thanks

 

[offthelip]

try this code which uses variant arrays and should be very fast. (UNTESTED!!)

Sheets("Sending List").Select


Dim Lastrow1, Lastrow2 As Long
Dim ws1, ws2 As Worksheet
Dim tempVal, tempVal2 As String


Set ws1 = Sheets("Sending List")
Set ws2 = Sheets("P13 D-Chain Status")
Lastrow1 = ws1.Range("B" & Rows.Count).End(xlUp).Row
Lastrow2 = ws2.Range("B" & Rows.Count).End(xlUp).Row






With ws2
 ' load columns A to G into a variant array
 inarr = Range(.Cells(1, 1), .Cells(Lastrow2, 7))
'.Range("Q2:Q" & Lastrow2).Formula = "=A2&D2"
'.Range("R2:R" & Lastrow2).Formula = "=G2"
End With


With ws1
 ' load the two columns to lookup
 lookuparr = Range(.Cells(1, 1), .Cells(Lastrow1, 2))
 ' load output array
 outarr = Range(.Cells(1, 4), .Cells(Lastrow1, 4))
 ' loop through the rows
  For i = 2 To Lastrow1
    tempVal1 = lookuparr(i, 1) & lookuparr(i, 2)
    
   For j = 2 To Lastrow2
    tempVal2 = inarr(j, 1) & inarr(j, 4)
    If tempVal1 = tempVal2 Then
    outarr(i, 1) = inarr(j, 7)
    End If
   Next j
  Next i
  Range(.Cells(1, 4), .Cells(Lastrow1, 4)) = outarr

 

[Fluff]

Another option

Sub yango()
   Dim ws1 As Worksheet, ws2 As Worksheet
   Dim Cl As Range
   
   Set ws1 = Sheets("Sending List")
   Set ws2 = Sheets("P13 D-Chain Status")
   
   With CreateObject("scripting.dictionary")
      .CompareMode = 1
      For Each Cl In ws2.Range("A2", ws2.Range("A" & Rows.Count).End(xlUp))
         .Item(Cl.Value & "|" & Cl.Offset(, 3).Value) = Cl.Offset(, 6).Value
      Next Cl
      For Each Cl In ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp))
         If .exists(Cl.Value & "|" & Cl.Offset(, 1).Value) Then
            Cl.Offset(, 3).Value = .Item(Cl.Value & "|" & Cl.Offset(, 1).Value)
         End If
      Next Cl
   End With
End Sub

If you have 10,000+ rows this can be speeded up.