CODEWITHSUNDEEP
excelexcel-2010vba
GarretB
GarretB

Reputation: 1

Looking Up Values in Separate Workbook and Copying Data to This Workbook

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:\Users\Username\Desktop\Database.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 Sub

Upvotes: 0

Views: 7917

Answers (3)

pnuts
pnuts

Reputation: 59495

You mentioned I tried vlookup and got a result I wasn't looking for but this should work, though you would have to update links if the sheet with the lookup table is not open in the same session.

Upvotes: 0

Alex
Alex

Reputation: 1642

Try this:

Sub Retrieve()
Application.ScreenUpdating = False
Dim lookuprng As Range

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("C:\Users\username\Desktop\Database.xlsm")
Set lookuprng = wb2.Sheets("Data").Range("look up range in Database")
Set ws1 = wb1.Sheets("Import")
ws1.Range("C7:C100000").ClearContents
wb1.Activate
With ws1
i = 7
Do Until .Cells(i, 2) = ""
    Cells(i, 5).Value = Application.VLookup(Cells(i, 2).Value, lookuprng, 2, 0)
    i = i + 1
Loop
End With
End Sub

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166835

Untested:

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:\Users\Username\Desktop\Database.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

Upvotes: 1

Related Questions