I’ve been working on this one for a couple weeks now and I can’t seem to get it right. The concept seems easy which is why I’m so frustrated with it. I finally resorted to posting here for some input.
The idea behind this is similar to a vlookup (I tried vlookup and got a result I wasn’t looking for). On ThisWorkbook, I set “Desc” equal to cell B7. I then want to look this up in a separate workbook which is the database. Once “Desc” is found in the database, I want to copy the data in column D and paste it to the cell to the right of “Desc” in the original workbook. I need to repeat the Copy-Paste process for the rest of the cells in column B under “Desc”. Thanks in advance. Cheers.
Option Explicit
Dim i As Integer, n As Integer
Dim Desc As Range, ExDesc As Range
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Sub Retrieve()
Application.ScreenUpdating = False
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Import")
ws1.Range("C7:C100000").ClearContents
With ws1
i = 7
Do Until .Cells(i, 2) = ""
Set Desc = ws1.Cells(i, 2)
With Workbooks.Open("C:UsersUsernameDesktopDatabase.xlsm")
Set wb2 = ActiveWorkbook
Set ws2 = wb2.Sheets("Data")
n = 2
Do Until ws2.Cells(n, 2) = ""
Set ExDesc = Cells(n, 2)
If ExDesc = Desc Then
ExDesc.Offset(0,2).Copy
End If
n = n + 1
Loop
End With
i = i + 1
Loop
End With
End Sub
Public Sub Paste()
wb1.Activate
ws1.Cells(i, 3).Paste
End SubUntested:
Sub Retrieve()
Dim i As Integer, n As Integer
Dim Desc As Range, ExDesc As Range
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngLookup As Range
Dim v
Application.ScreenUpdating = False
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Import")
ws1.Range("C7:C100000").ClearContents
Set wb2 = Workbooks.Open("C:UsersUsernameDesktopDatabase.xlsm")
With wb2.Sheets("Data")
Set rngLookup = .Range(.Cells(7, 2), _
.Cells(7, 2).End(xlDown)).Resize(, 3)
End With
With ws1
i = 7
Do Until .Cells(i, 2) = ""
v = Application.VLookup(.Cells(i, 2).Value, rngLookup, 3, False)
If Not IsError(v) Then .Cells(i, 4).Value = v
i = i + 1
Loop
End With
wb2.Close False
End Sub 
