Search code examples
excelvba

Excel VBA Findfirst equivalent between spreadsheets?


I'm trying to setup a macro that will function similar to FindFirst when using a recordset from MS Access in Excel.

I really really don't want to use a VLOOKUP or XLOOKUP formula. and MS Access is off the table. I'd rather have VBA use a loop to find matches and fill in the data.

The idea is for a user to copy and paste under the Packnum column and the matching data from the Table sheet would auto fill col B-D.

Here is my code (I've simulated the findfirst coding to give a better Idea of what I'm trying to do)

Any help or kick in the right direction would be greatly appreciated.

Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim CurRetails As Excel.Workbook
Dim RetInput As Excel.Worksheet
Dim Table As Excel.Worksheet

Dim lrow As Long
Dim Owner As String

Owner = Environ("USERNAME")
    'Workbook
    Set CurRetails = ThisWorkbook
    'Worksheets
     Set RetInput = CurRetails.Worksheets("Input")
     Set Table = CurRetails.Worksheets("Table")
     
    'Identify KeyCells
    Set KeyCells = Range("A2:A5000")

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing And Range("A2").Value > 100 Then

    'set lrow
     lrow = Cells(Rows.Count, 1).End(xlUp).Row
     
For i = 2 To lrow
Table.FindFirst ("[Packnum]= '" & RetInput.Range("A" & i).Value & "'")
    If RetInput.Range("A" & i).Value <> "" Then
        RetInput.Range("D" & i).Value = Table.Fields("[Original Retail]").Value
        RetInput.Range("C" & i).Value = Table.Fields("[CurRetail]").Value
        RetInput.Range("B" & i).Value = Table.Fields("[Description]").Value
    Else
    End If
Next i

Else
End If

End Sub

Solution

  • Not sure what's going on with the >100 check but ignoring that, something like this should work:

    Sub Worksheet_Change(ByVal Target As Range)
        Dim Table As Worksheet, rng As Range, c As Range, m As Variant
        Dim rwRes As Range, ok As Boolean, v
        
        'run some checks...
        Set rng = Application.Intersect(Target, Me.Range("A2:A5000"))
        If rng Is Nothing Then Exit Sub 'no monitored cell(s) updated
        
        Set Table = ThisWorkbook.Worksheets("Table")
        For Each c In rng.Cells  'loop over changed cell(s)
            ok = False           'reset successful lookup flag
            v = c.Value   'the lookup term
            If IsNumeric(v) Then    'anything to search for?
                m = Application.Match(v, Table.Columns("A"), 0) 'match on Col A
                If Not IsError(m) Then          'got a match?
                    Set rwRes = Table.Rows(m)   'the matched row
                    With c.EntireRow
                        'just example source columns on `Table`
                        .Columns("D").Value = rwRes.Columns("B").Value
                        .Columns("C").Value = rwRes.Columns("C").Value
                        .Columns("B").Value = rwRes.Columns("D").Value
                    End With
                    ok = True
                End If
            End If
            'no numeric value entered, or no match - clear B:D on this row
            If Not ok Then c.EntireRow.Range("B1:D1").ClearContents
        Next c
    End Sub