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
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