VBA VLookup or Match Function to return Rows instead of Single Cell Value That Meet Condition

bemp87

Board Regular
Joined
Dec 10, 2016
Messages
102
Hi Community,

The following code works perfectly for returning a single row that meets a specific value, but if there are numerous rows that meet the given condition in range A:A it only returns the first row, and not any additional rows that meet the given value. Any guidance here.

Code:
[COLOR=#333333][COLOR=#333333]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR][/COLOR][COLOR=#333333]   Dim Fnd As Range[/COLOR]   If Target.CountLarge > 1 Then Exit Sub
   If Target.Address(0, 0) = "B24" Then
      Set Fnd = Sheets("Data").Range("A:A").Find(Target.Value, , , xlWhole, , , False, , False)
      If Not Fnd Is Nothing Then
         Range("A30:X30").Value = Fnd.Resize(, 25).Value
      Else
         MsgBox "Not found"
      End If [COLOR=#333333]   End If [/COLOR][COLOR=#333333][COLOR=#333333]End Sub[/COLOR][/COLOR]
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
And where do you want the following results, in "A31:X31", "A32:X32" and so on?
 
Upvote 0
Hi Dante,

Here is the updated code: What i want to happen is that if the values are found on the "Test" sheet, then the results / rows should be placed on the "Tasks" sheet starting at "A2" and continue on based on however many rows were found. Hope that makes sense.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)   Dim Fnd As Range
   If Target.CountLarge > 15 Then Exit Sub
   If Target.Address(0, 0) = "A1" Then
      Set Fnd = Sheets("Test").Range("A1:A50").Find(Target.Value, , , xlWhole, , , True, , True)
      Application.Run "Data"
      If Not Fnd Is Nothing Then
         Range("A3:D8").Value = Fnd.Resize(, 25).Value
      Else
         MsgBox "You have entered an invalid employee name. Please try again."
      End If
   End If
End Sub
 
Upvote 0
The above made more sense!
But try the following:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Fnd As Range, j As Long
  Dim c As Range, r As Range, cell As String
  If Target.CountLarge > 1 Then Exit Sub
  j = 2
  If Target.Address(0, 0) = "A1" Then
    Set r = Sheets("[COLOR=#ff0000]Test[/COLOR]").Range("A:A")
    Set Fnd = r.Find(Target.Value, , xlValues, xlWhole, , , False, , False)
    '[COLOR=#333333]Application.Run "Data"  '[/COLOR]I did not try this part
    If Not Fnd Is Nothing Then
        cell = Fnd.Address
        Do
          Range("A" & j & ":X" & j).Value = Fnd.Resize(, 24).Value
          j = j + 1
          Set Fnd = r.FindNext(Fnd)
        Loop While Not Fnd Is Nothing And Fnd.Address <> cell
    Else
       MsgBox "Not found"
    End If
  End If
End Sub
 
Upvote 0
Thanks Dante- this works perfectly! One more question, when A1 is nothing, essentially it should erase the rows or clear the rows that may have been returned from a prior match, any idea how to accomplish this using the code. I tried tweaking it but i'm coming up short.
 
Upvote 0
Thanks Dante- this works perfectly! One more question, when A1 is nothing, essentially it should erase the rows or clear the rows that may have been returned from a prior match, any idea how to accomplish this using the code. I tried tweaking it but i'm coming up short.

Try

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Fnd As Range, j As Long
  Dim c As Range, r As Range, cell As String
  If Target.CountLarge > 1 Then Exit Sub
  j = 2
  If Target.Address(0, 0) = "A1" Then
[COLOR=#ff0000]    [/COLOR][COLOR=#0000ff]Range("A" & j & ":X" & rows.count).clearcontents
    if target.value = "" then exit sub[/COLOR][COLOR=#ff0000][/COLOR]
    Set r = Sheets("Test").Range("A:A")
    Set Fnd = r.Find(Target.Value, , xlValues, xlWhole, , , False, , False)
    'Application.Run "Data"  'I did not try this part
    If Not Fnd Is Nothing Then
        cell = Fnd.Address
        Do
          Range("A" & j & ":X" & j).Value = Fnd.Resize(, 24).Value
          j = j + 1
          Set Fnd = r.FindNext(Fnd)
        Loop While Not Fnd Is Nothing And Fnd.Address <> cell
    Else
       MsgBox "Not found"
    End If
  End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,567
Messages
6,114,344
Members
448,570
Latest member
rik81h

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top