CODEWITHSUNDEEP
excelvbafindrange
VBAbyMBA
VBAbyMBA

Reputation: 826

Find a word in Range and Find it again until the end of Range

I need to Find a word in Range("A1:A7500") then Find it again until the end of the Range (just like MSword VBA). Whenever word is found I need to do something with it or you can say count the occurrence.

But problem is, the Range will change when text is found. So how can I reset my range from next row where the text is found to the end? or is there any-other way to have the same result?

    Dim FIN,FOUN As Range
    Set FIN = Sheets("Sheet2").Range("A1:A7500")
    Do
    Set FOUN = FIN.find("TEXT", LookIn:=xlValues)

     ' IF FOUND THEN DO SOMETHING HERE

    Loop

Upvotes: 0

Views: 344

Answers (2)

Tragamor
Tragamor

Reputation: 3634

I would accomplish this with a generic FindAll function.

For Example:

Sub FindTest()
    Dim r As Range, Cell As Range
    Set r = FindAll("Test", Sheets("Sheet2").Range("A1:A7500"), LookAt:=xlPart)

    If Not r Is Nothing Then
        Debug.Print r.Count
        For Each Cell In r
            Cell.value = "Test2"
        Next Cell
    End If
End Sub

Private Function FindAll(What, _
    Optional SearchWhat As Variant, _
    Optional LookIn, _
    Optional LookAt, _
    Optional SearchOrder, _
    Optional SearchDirection As XlSearchDirection = xlNext, _
    Optional MatchCase As Boolean = False, _
    Optional MatchByte, _
    Optional SearchFormat, _
    Optional IncludeMerged As Boolean = False) As Range

    'LookIn can be xlValues or xlFormulas, _
     LookAt can be xlWhole or xlPart, _
     SearchOrder can be xlByRows or xlByColumns, _
     SearchDirection can be xlNext, xlPrevious, _
     MatchCase, MatchByte, and SearchFormat can be True or False. _
     Before using SearchFormat = True, specify the appropriate settings for the Application.FindFormat _
     object; e.g. Application.FindFormat.NumberFormat = "General;-General;""-""" _
     Set IncludeMerged to 'True' to include all cells within a merged area

    Dim SrcRange As Range
    If IsMissing(SearchWhat) Then
        Set SrcRange = ActiveSheet.UsedRange
    ElseIf TypeOf SearchWhat Is Range Then
        Set SrcRange = IIf(SearchWhat.Cells.Count = 1, SearchWhat.Parent.UsedRange, SearchWhat)
    ElseIf TypeOf SearchWhat Is Worksheet Then
        Set SrcRange = SearchWhat.UsedRange
    Else: SrcRange = ActiveSheet.UsedRange
    End If
    If SrcRange Is Nothing Then Exit Function

    'get the first matching cell in the range first
    With SrcRange.Areas(SrcRange.Areas.Count)
        Dim FirstCell As Range: Set FirstCell = .Cells(.Cells.Count)
    End With

    Dim CurrRange As Range: Set CurrRange = SrcRange.Find(What:=What, After:=FirstCell, LookIn:=LookIn, LookAt:=LookAt, _
        SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)

    If Not CurrRange Is Nothing Then
        Set FindAll = IIf(IncludeMerged = True, CurrRange.MergeArea, CurrRange)
        Do
            Set CurrRange = SrcRange.Find(What:=What, After:=CurrRange, LookIn:=LookIn, LookAt:=LookAt, _
            SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)
            If CurrRange Is Nothing Then Exit Do
            If Application.Intersect(FindAll, CurrRange) Is Nothing Then
                Set FindAll = Application.Union(FindAll, IIf(IncludeMerged = True, CurrRange.MergeArea, CurrRange))
            Else: Exit Do
            End If
        Loop
    End If
End Function

Upvotes: 1

Zac
Zac

Reputation: 1944

Try this:

Sub FindAndChange()

    Dim oWS As Worksheet: Set oWS = ThisWorkbook.Worksheets("Sheet3")   ' <- change the worksheet to point to your sheet
    Dim iLastRow As Long: iLastRow = oWS.Range("A" & oWS.Rows.Count).End(xlUp).Row
    Dim oRng As Range: Set oRng = oWS.Range("A1:A" & iLastRow)          ' <- change the column name if its not column A
    Dim oFoundRng As Range, oLastRng As Range
    Dim sTextToFind As String: sTextToFind = "test"

    ' Find the first instance of the text to find
    Set oFoundRng = oRng.Find(sTextToFind)

    ' Loop to find all instances of the text
    Do While Not oFoundRng Is Nothing

        oFoundRng.Value = "Found test"              ' Change the text to whatever it is you want to here
        Set oLastRng = oFoundRng                    ' Assign the current range to last range so that we dont go into an endless loop
        Set oFoundRng = oRng.FindNext(oFoundRng)    ' Find the next instance of the text
        If oLastRng >= oFoundRng Then               ' Ensure we dont start from the top again
            Exit Do                                 ' We are back at the top so exit loop
        End If
    Loop

    ' Clear objects
    Set oFoundRng = Nothing
    Set oWS = Nothing

End Sub

Upvotes: 1

Related Questions