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

[bemp87]

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.

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

 

[DanteAmor]

And where do you want the following results, in "A31:X31", "A32:X32" and so on?

 

[bemp87]

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.

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

 

[DanteAmor]

The above made more sense!
But try the following:

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

 

[bemp87]

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.

 

[DanteAmor]

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

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