VBA: Extract data using Vlookup and Offset

Question

I am trying to pull data out of a large spreadsheet using VBA. Column A contains ID's which can repeat depending on the data stored in it.

For example i have

ID           Value1             Value2
1111         item1               item2
1111         item3               item4
2222         item3               item4
3333         item3               item4
3333         item3               item4

I enter the ID into a spreadsheet then want to use VBA to Vlookup the ID then pull the Values from column B and C into another spreadsheet.

Heres what i have

    Sub populate()
Dim ID As String    
Dim Value1 As String
ID = Range("D5")
   Value1 = Application.WorksheetFunction.VLookup(ID, Worksheets("Required").Range("A4:J1913"), 2, False)
Response = Application.WorksheetFunction.VLookup(ID, Worksheets("Required").Range("A4:J1913"), 7, False)
Worksheets("Coversheet").Range("D8") = Value1
Worksheets("Coversheet").Range("D10") = Value2
Dim Value1address As Long
Value1address = VarPtr(Value1)
Worksheets("Coversheet").Range("D15").Value = Cells(Value1address).Offset(1, 0)
End Sub

The code works excatly how i want, except for the last 3 lines. I am trying to get an offset from Value1 by 1 row, however it is saving as a blank, and consequently puts a blank value into Cell D15.

Can anyone help me solve this problem, or how i can easily take data from the following rows after the Vlookup?

score 1 · Accepted Answer · 2016-02-18 03:50:12Z

1

Use the worksheet's MATCH function to return the row number to an INDEX function while adding +1 to it.

with Worksheets("Required")
    Worksheets("Coversheet").Range("D15").Value = _
      Application.Index(.Range("B4:B1913"), Application.Match(ID, .Range("A4:A1913"), 0) + 1))
End With

If you are finding the row, then store it and keep reusing it.

    Dim ID As String, val1 As String, val2 As String, val3 As String, rw As Long
    ID = Range("D5")

    With Worksheets("Required")
        If Not IsError(Application.Match(ID, .Range("A4:A1913"), 0)) Then
            rw = Application.Match(ID, .Range("A4:J1913"), 0)
            val1 = .Cells(rw + 3, 2).Value
            val2 = .Cells(rw + 3, 7).Value
            val3 = .Cells(rw + 4, 2).Value
        End If
    End With

    With Worksheets("Coversheet")
        .Range("D8") = val1
        .Range("D10") = val2
        .Range("D15") = val3
    End With

Native Worksheet formulas

This could also be handled by standard (non-array) worksheet formula. In D8, D10 and D15 as,

=INDEX(Required!$B$4:$B$914, MATCH($D$5, Required!$A$4:$A$914, 0))
=INDEX(Required!$J$4:$J$914, MATCH($D$5, Required!$A$4:$A$914, 0))
=IFERROR(INDEX(Required!$B$4:$B$914, AGGREGATE(15, 6, ROW($1:$911)/(Required!$A$4:$A$914=$D$5), 2)), "n/a")

edited Feb 18, 2016 at 3:50

answered Feb 18, 2016 at 3:31

user4039065

Sign up to request clarification or add additional context in comments.

2 Comments

Stackuser90 Over a year ago

with Worksheets("Required") Worksheets("Coversheet").Range("D15").Value = _ Application.Index(.Range("B4:B1913"), Application.Match(ID, .Range("A4:A1913"), 0) + 1)) End With This will keep dumping data even if the ID has changed. For example i only want it to dump for the matched ID in D5. If i used this method for ID 2222, it would dump the next row of value, which is id 3333

user4039065 Over a year ago

Yes that's true. It is also exactly like what you were trying to accomplish with VarPtr. Having recognized that, I offered a secondary method that does not.

ImkeF · Accepted Answer · 2016-02-20 09:54:44Z

0

I recommend using Power Query for this task (or Get&Transform if you're on 2016 already): https://www.dropbox.com/s/my59casl9y8ac3y/SO_ExtractDataUsingVLookupAndOffset.xlsx?dl=0

Code is pretty short (i.e. for Var1):

let
    Filter= Excel.CurrentWorkbook(){[Name="ID"]}[Content][Column1]{0},
    Source = Excel.CurrentWorkbook(){[Name="Tabelle1"]}[Content],
    #"Filtered Rows" = Table.SelectRows(Source, each [ID] = Filter)
in
    #"Filtered Rows"

You have all formatting options for the output and the solution is fully dynamic:

answered Feb 20, 2016 at 9:54

ImkeF

1,5983 gold badges13 silver badges12 bronze badges

Collectives™ on Stack Overflow

VBA: Extract data using Vlookup and Offset

2 Answers 2

2 Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related