Home » excel » excel – '.Find'/'.FindNext' finding same cell repeatedly or returns error

excel – '.Find'/'.FindNext' finding same cell repeatedly or returns error

Posted by: admin April 23, 2020 Leave a comment

Questions:

I have a list of medical terms (Column F) and their associated numerical codes (Column G), and I need to find the medical term from Column F IN the list in Column B and put that term’s associated code in Column C.

An image of a simplified version of my spreadsheet:

simplified version of my spreadsheet

what I want the spreadsheet to look like after the code is run:

after the code is run

My problem here is getting the code to find the next match within the list. The example I have in the images is for the medical term: abnormal gait. You can see that there are two matches in Column B (the first and last cells). The code I have for this is modified from the examples from Microsoft and [this other website that many of the forums have been recommending as a resource][3]. However, no matter how many times I try to modify the second ‘find’ command I always end up with one of these errors:

  1. Unable to get the FindNext Property of the Range Class
  2. Type Mismatch Error
  3. The Find function repeatedly finds the same cell
  4. The Find function finds the first cell, but it never finds the next cell and exits via End If.

    Sub Match2Cohort()
    Dim Phenotype, FindMe, FoundinList As Range
    Dim LRp, LastRow, i As Long
    Dim FirstMatch As String
    
    LRp = Cells(Rows.Count, 2).End(xlUp).Row
    LastRow = Cells(Rows.Count, 6).End(xlUp).Row
    Set Phenotype = Range("B1:b" & LRp)
    Set Terms = Range("F1:f" & LastRow)
    
    For i = 18 To LastRow
        FindMe = Cells(i, 6).Value
        Set FoundinList = Phenotype.Cells.Find(What:=FindMe, LookAt:=xlWhole)
        On Error Resume Next
    
        If Not FoundinList Is Nothing Then
            FirstMatch = FoundinList.Row
            Do
    'This loop allows me to combine multiple medical codes into the same cell.                    
                If IsEmpty(FoundinList.Offset(0, 1)) = True Then
                        FoundinList.Offset(0, 1) = Cells(i, 7).Value
                Else: FoundinList.Offset(0, 1) = FoundinList.Offset(0, 1).Value & "/" & Cells(i, 7).Value
                FoundinList.Offset(0, 1).Select
                End If
    
    'This is the code that is not working and all of the variations I've tried:
        With Phenotype
            Set FoundinList = .FindNext(FindMe)
            Set FoundinList = .FindNext(FindMe, After:=ActiveCell)
            Set FoundinList = .FindNext(After:=ActiveCell)
        End With
    
            Set FoundinList = Phenotype.FindNext(What:=FindMe, After:=ActiveCell, LookAt:=xlWhole)
            Set FoundinList = Phenotype.Find(What:=FindMe, After:=ActiveCell, LookAt:=xlWhole)
            Set FoundinList = Phenotype.FindNext(After:=FoundinList)
            Set FoundinList = Phenotype.FindNext(What:=FindMe, After:=FoundinList, LookAt:=xlWhole)
            Set FoundinList = Phenotype.Find(What:=FindMe, After:=FoundinList, LookAt:=xlWhole)
    
            Loop While FirstMatch <> FoundinList.Row
        End If
    Next i
    
    End Sub
    

At this point I have tried everything I can think of and everything I have found online, and just don’t know what to try next.

How to&Answers:

Here is an efficient solution to your problem that does not use the .Find or .FindNext methods.

Sub Match2Cohort()
    Dim i&, k&, TTmp$, PTmp$, p, t
    t = [f1].CurrentRegion.Resize(, 2)
    With ActiveSheet
        p = [b1].Resize(.Cells(.Rows.Count, "b").End(xlUp).Row, 2)
    End With
    For i = 1 To UBound(t)
        TTmp = LCase$(Replace(t(i, 1), " ", ""))
        For k = 1 To UBound(p)
            PTmp = "," & LCase$(Replace(p(k, 1), " ", "")) & ","
            If InStr(PTmp, "," & TTmp & ",") Then
                PTmp = p(k, 2) & "/" & t(i, 2)
                If Left$(PTmp, 1) = "/" Then PTmp = Mid$(PTmp, 2)
                p(k, 2) = PTmp
            End If
        Next
    Next
    [b1].Resize(UBound(p), UBound(p, 2)) = p
End Sub

Answer:

I think this is what you’re trying to write:

Sub Match2Cohort()

    Dim Phenotype As Range, FindMe As String, FoundinList As Range
    Dim LRp As Long, LastRow As Long, i As Long
    Dim FirstMatch As String
    Dim Terms As Range

    LRp = Cells(Rows.Count, 2).End(xlUp).Row
    LastRow = Cells(Rows.Count, 6).End(xlUp).Row
    Set Phenotype = Range("B1:B" & LRp)
    Set Terms = Range("F1:F" & LastRow)

    For i = 18 To LastRow
        FindMe = Cells(i, 6).Value2

        'Find first occurrence.
        Set FoundinList = Phenotype.Cells.Find( _
            What:=FindMe, _
            After:=Phenotype.Cells(1), _
            LookAt:=xlPart, _
            SearchDirection:=xlNext)

        If Not FoundinList Is Nothing Then
            FirstMatch = FoundinList.Address
            Do
                If IsEmpty(FoundinList.Offset(0, 1)) Then 'No need for "=TRUE" as the statement returns TRUE/FALSE
                    FoundinList.Offset(0, 1) = Cells(i, 7).Value
                Else
                    FoundinList.Offset(0, 1) = FoundinList.Offset(0, 1).Value & "/" & Cells(i, 7).Value
                End If

                Set FoundinList = Phenotype.FindNext(FoundinList)
            Loop While Not FoundinList Is Nothing And FirstMatch <> FoundinList.Address
        End If

    Next i

End Sub

Answer:

Ok, so i think the best solution is to move away from FIND() and use strings.split, and application.index and application.match

Here’s the logic:

Loop 1 ‘loop through cells in column B

Split the cells text at the comma and place in an array

Loop 2 ‘ loop through individual Phenotype array

Use application.match to find the term and code in columns F:G

Add the code to the cell in column C.

And here is the code:

Sub Text_Loop()
Dim i As Integer
Dim RngF as Range, RngB As Range
Dim mycell As Range
Dim phenoString() As String
Dim phenoCode As Variant

Set RngB = Sheet1.Range("b2:b" & Sheet1.Range("b2").End(xlDown).Row)
Set RngF = Sheet1.Range("F2:F" & Sheet1.Range("F2").End(xlDown).Row)

For Each mycell In RngB 'first loop
    phenoString = Split(mycell.Value, ",")

    For i = LBound(phenoString) To UBound(phenoString) 'second loop
        phenoCode = Application.Index(Sheet1.Range("F2:G" & Sheet1.Range("F2").End(xlDown).Row), _
            Application.Match(phenoString(i), RngF, 0), 2) 'use variant so that we can check for an error

        If WorksheetFunction.IsError(phenoCode) = False Then 'checks to make sure phenocode was found
            If mycell.Offset(0, 1) <> "" Then 'formats multiple phenotype codes with / in correct place
                mycell.Offset(0, 1) = mycell.Offset(0, 1) & "/" & phenoCode
            Else
                mycell.Offset(0, 1) = phenoCode
            End If
        End If

    Next i 'end first loop
Next mycell 'end second loop


End Sub