Excel VBA Range.Find not working - no data or error returned

Question

Good day all,

I have been trying to use the range.find method to find a string from an existing cell in a column in a different sheet in the same workbook. When I use the debugger to walk through the code it never gives a result from the range.find method. I am completely perplexed by this (not an uncommon state for me...) Please review the below code and let me know what I am doing wrong. Thanks!!!

Function Dupe_BU_List(strSuplName As String) As String
Dim sht As Worksheet
Dim ws As Worksheet

Dim rngSearchRange As Range
Dim rngFoundCell As Range
Dim intBUCol As Integer
Dim intLegacyCol As Integer
Dim lngSuplCnt As Long
Dim shtRow As Long
Dim shtColG As String
Dim shtColH As String
Dim strTestSupl As String
Dim strCurrSupl As String
Dim strNextSupl As String
Dim strCurrBU As String
Dim strNextBU As String
Dim strFirstAddress As String
Dim varLegacyIDs As Variant
Dim varBUSuplNames As Variant
Dim strDupe_BU_List As String


Set ws = ThisWorkbook.Sheets("All ADG Suppliers") ' Sheet exists with data
Set sht = ThisWorkbook.Sheets("Name Corr") ' Sheet exists with data
Set rngSearchRange = ws.Range("C:C") 'List being searched is here and is populated and has matching data

intBUCol = 1
intLegacyCol = 2
shtColG = "G"
shtColH = "H"
shtRow = ActiveCell.Row


Dupe_BU_List = ""
strDupe_BU_List = ""
varLegacyIDs = ""
varBUSuplNames = ""
strSuplName = Shortened_Supl_Name(strSuplName)
'**This is where it fails**
**Set rngFoundCell = rngSearchRange.Find(What:=strSuplName, LookIn:=xlValues, LookAt:=xlPart)
If Not rngFoundCell Is Nothing Then
    strFirstAddress = rngFoundCell.Address ' Store the first address to avoid infinite loop
    strDupe_BU_List = rngFoundCell.Offset(0, intBUCol - rngFoundCell.Column).Value
    varLegacyIDs = rngFoundCell.Offset(0, intLegacyCol - rngFoundCell.Column).Value
    varBUSuplNames = rngFoundCell.Value
    Do While Not rngFoundCell Is Nothing
        ' Find the next match
        Set rngFoundCell = rngSearchRange.FindNext(rngFoundCell)
        If Not rngFoundCell Is Nothing Then
            If rngFoundCell.Address <> strFirstAddress Then
                strDupe_BU_List = strDupe_BU_List & ";" & rngFoundCell.Offset(0, intBUCol - rngFoundCell.Column).Value
                varLegacyIDs = varLegacyIDs & ";" & rngFoundCell.Offset(0, intLegacyCol - rngFoundCell.Column).Value
                varBUSuplNames = varBUSuplNames & ";" & rngFoundCell.Value
            Else
                Exit Do
            End If
        Else
            MsgBox ("Issues with range.findnext")
            Exit Do
        End If
    Loop
Else
    MsgBox ("Issues with initial range.find")
End If**

If Left(strDupe_BU_List, 1) = ";" Then
    Dupe_BU_List = Right(strDupe_BU_List, Len(strDupe_BU_List) - 1)
    'sht.Range(shtColG & shtRow).Value = varLegacyIDs
    'sht.Range(shtColH & shtRow).Value = varBUSuplNames
Else
    Dupe_BU_List = strDupe_BU_List
End If

End Function    


Function Shortened_Supl_Name(strLongSuplName) As String
    Dim strShortSuplName As String
    Dim varPunc As Variant
    Dim varElements As Variant
    Dim p As Long
    Dim e As Long
    
    strShortSuplName = strLongSuplName
    varPunc = Array("-", ".", ",")
    varElements = Array("-", " ", ".", " ", ",", " DC", " INC", " LLC", " LLP", " L P", " LTD", " NA", " P C", " PC")
    For p = LBound(varPunc) To UBound(varPunc)
        strShortSuplName = Replace(strShortSuplName, varPunc(p), " ")
    Next p
    
    For e = LBound(varElements) To UBound(varElements)
        strShortSuplName = Replace(strShortSuplName, varElements(e), " ")
    Next e
    
    Shortened_Supl_Name = Trim(strShortSuplName)
End Function

Check the search term by adding Else : MsgBox "not found '" & strSuplName & "'" after Loop . Also add Else: Exit Do after varBUSuplNames = ... otherwise if a match is found it will enter a infinite loop. — CDP1802
– CDP1802, Commented May 13 at 14:55
I'm trying to create a list of neighboring column data using this technique. So, I want to loop until no further duplicates are found. I don't want to exit the loop pre-maturely. — R C
– R C, Commented May 13 at 15:25
You aren't exiting prematurely though, find will loop back to the first item found if you don't break the loop. — Warcupine
– Warcupine, Commented May 13 at 15:28
Excel completely locks up when processing the 1st row of data in this line of code: Set rngFoundCell = rngSearchRange.Find(What:=strSuplName, LookIn:=xlValues, LookAt:=xlPart) strSuplName = "(ACP) - ALL COPY PROD". I even added code to strip out the parentheses in case they were an issue. That didn't help. — R C
– R C, Commented May 13 at 15:49
Did you add Exit Do ? You need to exit If rngFoundCell.Address = strFirstAddress — CDP1802
– CDP1802, Commented May 13 at 15:56

Tim Williams · Accepted Answer · 2025-05-13 17:44:45Z

Using Find in a loop is tricky, so I find it's best to push that out into a separate reusable method. For example the function below returns a Collection of all matched cells. As noted above - the key part is to exit to loop once you get back to the fist cell found.

Function Dupe_BU_List(strSuplName As String) As String
    
    Const colSearch As String = "C"
    Const colBU As String = "G"         '<< adjust to suit
    Const colLegacy As String = "H"
    
    Dim sht As Worksheet, ws As Worksheet
    Dim rngSearchRange As Range, strDupe_BU_List As String
    Dim varLegacyIDs As String, varBUSuplNames As String
    Dim allMatches As Collection, c As Range
    
    Set ws = ThisWorkbook.Sheets("All ADG Suppliers") ' Sheet exists with data
    Set sht = ThisWorkbook.Sheets("Name Corr") ' Sheet exists with data
    Set rngSearchRange = ws.Columns(colSearch) 'List being searched is here and is populated and has matching data
    
    strSuplName = Shortened_Supl_Name(strSuplName)
    
    Set allMatches = FindAll(rngSearchRange, strSuplName, xlPart)
    If allMatches.count = 0 Then
        MsgBox "No cells matched '" & strSuplName & "'"
        Exit Function 'return empty string
    End If
    
    For Each c In allMatches 'loop over matches
        With c.EntireRow
            AddToList strDupe_BU_List, .Columns(colBU)
            AddToList varLegacyIDs, .Columns(colLegacy)
            AddToList varBUSuplNames, c.Value
        End With
    Next c
    
    Dupe_BU_List = strDupe_BU_List 'what about varLegacyIDs and varBUSuplNames?
End Function

'Add value `v` to string `lst`, with separator if needed
' `lst` is passed ByRef and updated
Sub AddToList(ByRef lst As String, v As String)
    lst = lst & IIf(Len(lst) > 0, ";", "") & v
End Sub

'Find all matches for `val` in `rng` and return as a Collection of cells
Public Function FindAll(rng As Range, val As String, matchType As XlLookAt) As Collection
    Dim rv As New Collection, f As Range, addr As String
    
    Set f = rng.Find(What:=val, After:=rng.Cells(rng.Cells.CountLarge), _
        LookIn:=xlValues, LookAt:=matchType, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False)
    
    Do While Not f Is Nothing
        If Len(addr) = 0 Then addr = f.Address 'first cell found?
        rv.Add f
        Set f = rng.FindNext(After:=f)
        If f.Address() = addr Then Exit Do 'looped back: exit here
    Loop
    Set FindAll = rv
End Function

Collectives™ on Stack Overflow

Excel VBA Range.Find not working - no data or error returned

1 Answer 1

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related