Find Nth Value without an Array

[dlrollings83]

I have a spreadsheet which has been amalgamated from few other, as such the data is not as I would like but the owner will not amend the data. I need to create a search engine of sorts using partial matches. I have the following formula for the first and second matches and they work fine but I cannot think how to arrange this, without an array formula, to search for the 3rd, 4th match etc.

The formula for the first match is: =VLOOKUP("*"&B4&"*",Sheet1!B1:H125,1,0)

The formula for the second match is: =VLOOKUP("*"&B4&"*",OFFSET(Sheet1!B1,MATCH("*"&B4&"*",Sheet1!B:B,0),0,125,7),1,0)

Without an array or helper column, is there a way to find the nth match where the data in Sheet1 column B contains the text in cell Sheet 2 B4?

Happy to consider a macro.

 

[Fluff]

With sheet 2 active, try

Sub getmatch()
   Dim fnd As Range
   Dim ws1 As Worksheet
   Dim i As Long
   
   Set ws1 = Sheets("Pcode")
   Set fnd = ws1.Range("B125")
   For i = 1 To 4
      Set fnd = ws1.Range("B1:B125").find(Range("B4").Value, fnd, , xlPart, , , False, , False)
      If Not fnd Is Nothing Then Range("B4").Offset(, i).Value = fnd
   Next i
End Sub

This will put the first 4 matches into cols C:F

 

[smpatty08]

I have a spreadsheet which has been amalgamated from few other, as such the data is not as I would like but the owner will not amend the data. I need to create a search engine of sorts using partial matches. I have the following formula for the first and second matches and they work fine but I cannot think how to arrange this, without an array formula, to search for the 3rd, 4th match etc.

The formula for the first match is: =VLOOKUP("*"&B4&"*",Sheet1!B1:H125,1,0)

The formula for the second match is: =VLOOKUP("*"&B4&"*",OFFSET(Sheet1!B1,MATCH("*"&B4&"*",Sheet1!B:B,0),0,125,7),1,0)

Without an array or helper column, is there a way to find the nth match where the data in Sheet1 column B contains the text in cell Sheet 2 B4?

Happy to consider a macro.

This will use autofilter to find an infinite number of partial text match within your specified range.

Sub FindMatch()
Dim str As String


'Sets String as variable
str = Sheet2.Range("B4").Text


'Inserts row at top of Sheet1 so everything is autofiltered
ActiveWorkbook.Sheets("Sheet1").Rows(1).Insert


'Autofilters based on partial text in Sheet2 B4
ActiveWorkbook.Sheets("Sheet1").Columns(2).AutoFilter Field:=1, Criteria1:="*" & str & "*"


'If filtered range is not empty then copy to Sheet2 A1
If IsEmpty(ActiveWorkbook.Sheets("Sheet1").Range("B2")) = False Then
    ActiveWorkbook.Sheets("Sheet1").Range("B2", Range("B2").End(xlDown)).Copy Destination:=ActiveWorkbook.Sheets("Sheet2").Range("A1")
End If


'Turns off Autofilter
ActiveWorkbook.Sheets("Sheet1").AutoFilterMode = "False"


'Deletes the row added
ActiveWorkbook.Sheets("Sheet1").Rows(1).EntireRow.Delete
End Sub

Just change the sheet names to match yours.

 

[dlrollings83]

This will use autofilter to find an infinite number of partial text match within your specified range.

Sub FindMatch()
Dim str As String


'Sets String as variable
str = Sheet2.Range("B4").Text


'Inserts row at top of Sheet1 so everything is autofiltered
ActiveWorkbook.Sheets("Sheet1").Rows(1).Insert


'Autofilters based on partial text in Sheet2 B4
ActiveWorkbook.Sheets("Sheet1").Columns(2).AutoFilter Field:=1, Criteria1:="*" & str & "*"


'If filtered range is not empty then copy to Sheet2 A1
If IsEmpty(ActiveWorkbook.Sheets("Sheet1").Range("B2")) = False Then
    ActiveWorkbook.Sheets("Sheet1").Range("B2", Range("B2").End(xlDown)).Copy Destination:=ActiveWorkbook.Sheets("Sheet2").Range("A1")
End If


'Turns off Autofilter
ActiveWorkbook.Sheets("Sheet1").AutoFilterMode = "False"


'Deletes the row added
ActiveWorkbook.Sheets("Sheet1").Rows(1).EntireRow.Delete
End Sub

Just change the sheet names to match yours.

I have tried this but get an error on:

'If filtered range is not empty then copy to Sheet2 A1
If IsEmpty(ActiveWorkbook.Sheets("Sheet1").Range("B2")) = False Then
ActiveWorkbook.Sheets("Sheet1").Range("B2", Range("B2").End(xlDown))Copy Destination:=Worksheets("Sheet2").Range("A1")

Error is stating Compile Error Expected: end of statement.

If I end the statement with .Copy Destination nothing happens when I run the macro.

 

[smpatty08]

Did you update the sheet names to match the ones used in your workbook?

If you don't have anything after .Copy Destination then it just copies the data, but then doesn't put it anywhere.

If you post your two sheet names so I can recreate your workbook that would be helpful.

 

[Fluff]

Have you tried my suggestion from post#2?