CODEWITHSUNDEEP
vbaexcel
Gareth Davis
Gareth Davis

Reputation: 13

VBA excel - return the last matching value in a column using VBA

Basically, I have a rather large (and growing) sheet of position details and I'm looking to build in a sub routine that, once a position number is entered into the relevant cell, will auto-populate the corresponding cells in the row. VLOOKUP would do the trick nicely except, when a position has multiple lines, it returns the earliest set of details--I need it to return the latest.

I can produce the answer I need using a LOOKUP function , but I can't seem to translate the function across to VBA.

Example lookup function:

LOOKUP(D17,1/($D$2:$D$10=D17),E2:E10)

This is what I have so far

Sub Worksheet_Change(ByVal Target As Excel.Range)

    If Target.Column = 4 Then
        actionrow = Target.Row

        resulte = Application.WorksheetFunction.Lookup(2, 1 / Range("D2:D10") = Target.Value, Range("E2:E10"))

        If Target.Value <> "" Then
            Range("E" & actionrow).formula = resulte
        End If
    End If

End Sub

Upvotes: 1

Views: 3368

Answers (2)

Yaroslav Zharkov
Yaroslav Zharkov

Reputation: 43

You can use .Find function with parameter SearchDirection:=xlPrevious

For case where you are searching word "AC" in a row 4:

 Set FindCell = sh_wb_SF.Range("4:4").Find(What:="AC", LookIn:=xlValues, SearchDirection:=xlPrevious)
        If FindCell Is Nothing Then
            MsgBox ("Ooooooopppps")
        End If

Upvotes: 0

user4039065
user4039065

Reputation:

I think that looking at column D for a matching value with the Range.Find method would do. Start at the Target cell and use the SearchDirection:=xlPrevious option. Something will always be found. If the row it is found is not the same row as Target then use the value in column E to populate the cell right of Target.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Columns(4), Target) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.EnableEvents = True
        Dim trgt As Range, lastrw As Long
        For Each trgt In Intersect(Columns(4), Target)
            lastrw = Columns(4).Find(what:=trgt.Value, after:=trgt, _
                                    lookat:=xlWhole, SearchDirection:=xlPrevious).Row
            Debug.Print lastrw
            If lastrw <> trgt.Row Then
                trgt.Offset(0, 1) = Cells(lastrw, trgt.Column + 1).Value
            End If
        Next trgt
    End If
bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

This should survive pasting multiple values into column D.

Upvotes: 1

Related Questions