Continue loop code until all occurrences of search term are found

Aug 4th 2010

#1

I have a search code that searches 1 columb at a time. When it finds the word i type it displays the results in a msgbox. That code works great but it stops running after it finds the first instance of the word. For example if i want to find "Oil filter" and there are more than one row with oil as the first word it stops when it finds oil. Can someone help me with a loop or whatever is needed to keep going until the end. Thanks guys. also i am a noob to vba so please be gentle. And thank you to SMC for writing this code.

Code

Dim rng As Range
    Dim lngColumns As Long
    Dim strMessage As String
    
    On Error Resume Next
    Set rng = Columns("e:e").Find(InputBox("Please enter your search parameter.", "Search...", "Text Here"))
    Err.Clear: On Error GoTo -1: On Error GoTo 0
    
    If Not rng Is Nothing Then
        For lngColumns = -3 To 3 'This will show the next 6 cells of the row
            strMessage = strMessage & rng.Offset(, lngColumns).Value & vbCrLf
        Next lngColumns
        MsgBox strMessage
    Else
        MsgBox "No Match Found!"
    End If
    
    Set rng = Nothing
    lngColumns = Empty
    strMessage = vbNullString

Display More

Thanks in advance for your help

AAE

Enlightened

Points

46,745

Posts

9,223
Aug 4th 2010
- #2
Re: Continue loop code until all occurrences of search term are found

yegarboy,

When creating a new thread, the importance of good thread titles is clearly stated. Thread titles should concisely and accurately describe your thread content, and be "search friendly", meaning a search using YOUR title as the search terms would yield relevant results.

Try your original title in search and see the results: "Loop until end"??? Can someone help fix this? My code stops at the first instance."

Note the change made to your title as an example and in future threads take care to give it a proper title. Future infractions of forum rules may impact your posting privilege and you may find threads locked or deleted for non-compliance. Please make yourself familiar the with forum rules you agreed to follow.
[COLOR="blue"][SIZE="4"][FONT="Verdana"]AAE[/FONT][/SIZE][/COLOR]
[COLOR="blue"]----------------------------------------------------[/COLOR]

Forum Rules | [COLOR="red"]Message to Cross Posters[/COLOR] | [COLOR="black"]How to use Tags[/COLOR]
yegarboy

Professional

Points

3,685

Posts

631
Aug 4th 2010
- #3
Re: Continue loop code until all occurrences of search term are found

I am so sorry Forums are new to me. I had tryed searching for help but i couldnt find what i was looking for. I will try harder in the future to look harder :smile:
[SIZE=3]The Only Dumb Question Is A Question Not Asked.[/SIZE]
yegarboy

Professional

Points

3,685

Posts

631
Aug 4th 2010
- #4
Re: Continue loop code until all occurrences of search term are found

Can anyone help?
[SIZE=3]The Only Dumb Question Is A Question Not Asked.[/SIZE]

Aug 4th 2010

#5

Re: Continue loop code until all occurrences of search term are found

Code

Sub FindLoopAll()


    Dim rng As Range
    Dim rngFirstOccurrence As Range
    Dim lngColumns As Long
    Dim strMessage As String
    Dim varSearchValue
    
    varSearchValue = InputBox("Please enter your search parameter.", "Search...", "Text Here")
    On Error Resume Next
    Set rngFirstOccurrence = Columns("e:e").Find(What:=varSearchValue) ', LookAt:=xlwhole
    Debug.Print rngFirstOccurrence.Address
    If Not rngFirstOccurrence Is Nothing Then
        For lngColumns = -3 To 3 'This will show the previous 3, current and next 3 cells of the row
            strMessage = strMessage & rngFirstOccurrence.Offset(, lngColumns).Value & vbCrLf
        Next lngColumns
    Else
        MsgBox "No Match Found!"
        GoTo ExitSub
    End If
    
    Do
        Set rng = Nothing
        Set rng = Columns("e:e").FindNext(rngFirstOccurrence)
        If rng.Row <= rngFirstOccurrence.Row Then
            Exit Do
        End If
        Debug.Print rng.Address
        Err.Clear: On Error GoTo -1: On Error GoTo 0
        
        If Not rng Is Nothing Then
            Set rngFirstOccurrence = Nothing
            Set rngFirstOccurrence = rng
            For lngColumns = -3 To 3 'This will show the previous 3, current and next 3 cells of the row
                strMessage = strMessage & rng.Offset(, lngColumns).Value & vbCrLf
            Next lngColumns
        End If
    Loop Until rng Is Nothing
    If strMessage = vbNullString Then
        MsgBox "No Match Found!"
    Else
        MsgBox strMessage
    End If
ExitSub:
    Set rng = Nothing
    lngColumns = Empty
    strMessage = vbNullString
    Set rngFirstOccurrence = Nothing
    
End Sub

Display More

yegarboy

Professional

Points

3,685

Posts

631
Aug 4th 2010
- #6
Re: Continue loop code until all occurrences of search term are found

Thank you very much SMC. If i can trouble you for 1 more fix i will leave you alone . When it returns the findings it puts everything in 1 big msgbox. Is there a way to show them individually? or am i SOL? Also how do i set the range for the columb start (e.g... My data starts at E7 and ends at E1500. E:E searches my heading and other used cells. Thanks again.
[SIZE=3]The Only Dumb Question Is A Question Not Asked.[/SIZE]

Aug 4th 2010

#7

Re: Continue loop code until all occurrences of search term are found

Code

Sub FindLoopAll()


    Dim rng As Range
    Dim rngFirstOccurrence As Range
    Dim lngColumns As Long
    Dim strMessage As String
    Dim varSearchValue
    
    varSearchValue = InputBox("Please enter your search parameter.", "Search...", "Text Here")
    On Error Resume Next
    Set rngFirstOccurrence = Range("E7:E1500").Find(What:=varSearchValue) ', LookAt:=xlwhole
    Debug.Print rngFirstOccurrence.Address
    If Not rngFirstOccurrence Is Nothing Then
        For lngColumns = -3 To 3 'This will show the previous 3, current and next 3 cells of the row
            strMessage = strMessage & rngFirstOccurrence.Offset(, lngColumns).Value & vbCrLf
        Next lngColumns
        MsgBox strMessage
        strMessage = vbNullString
    Else
        MsgBox "No Match Found!"
        GoTo ExitSub
    End If
    
    Do
        Set rng = Nothing
        Set rng = Range("E7:E1500").FindNext(rngFirstOccurrence)
        If rng.Row < rngFirstOccurrence.Row Then
            Exit Do
        End If
        Debug.Print rng.Address
        Err.Clear: On Error GoTo -1: On Error GoTo 0
        
        If Not rng Is Nothing Then
            Set rngFirstOccurrence = Nothing
            Set rngFirstOccurrence = rng
            For lngColumns = -3 To 3 'This will show the previous 3, current and next 3 cells of the row
                strMessage = strMessage & rng.Offset(, lngColumns).Value & vbCrLf
            Next lngColumns
            MsgBox strMessage
            strMessage = vbNullString
        End If
    Loop Until rng Is Nothing
ExitSub:
    Set rng = Nothing
    lngColumns = Empty
    strMessage = vbNullString
    Set rngFirstOccurrence = Nothing
    
End Sub

Display More

yegarboy

Professional

Points

3,685

Posts

631
Aug 4th 2010
- #8
Re: Continue loop code until all occurrences of search term are found

Not sure why but its freezing up excel
[SIZE=3]The Only Dumb Question Is A Question Not Asked.[/SIZE]

Aug 4th 2010

#9

Re: Continue loop code until all occurrences of search term are found

Try the revised code.... I've editted it in the post above, but just so that you are sure.. copying it here

Code

Sub FindLoopAll()


    Dim rng As Range
    Dim rngFirstOccurrence As Range
    Dim lngColumns As Long
    Dim strMessage As String
    Dim varSearchValue
    
    varSearchValue = InputBox("Please enter your search parameter.", "Search...", "Text Here")
    On Error Resume Next
    Set rngFirstOccurrence = Range("E7:E1500").Find(What:=varSearchValue) ', LookAt:=xlwhole
    Debug.Print rngFirstOccurrence.Address
    If Not rngFirstOccurrence Is Nothing Then
        For lngColumns = -3 To 3 'This will show the previous 3, current and next 3 cells of the row
            strMessage = strMessage & rngFirstOccurrence.Offset(, lngColumns).Value & vbCrLf
        Next lngColumns
        MsgBox strMessage
        strMessage = vbNullString
    Else
        MsgBox "No Match Found!"
        GoTo ExitSub
    End If
    
    Do
        Set rng = Nothing
        Set rng = Range("E7:E1500").FindNext(rngFirstOccurrence)
        If rng.Row < rngFirstOccurrence.Row Then
            Exit Do
        End If
        Debug.Print rng.Address
        Err.Clear: On Error GoTo -1: On Error GoTo 0
        
        If Not rng Is Nothing Then
            Set rngFirstOccurrence = Nothing
            Set rngFirstOccurrence = rng
            For lngColumns = -3 To 3 'This will show the previous 3, current and next 3 cells of the row
                strMessage = strMessage & rng.Offset(, lngColumns).Value & vbCrLf
            Next lngColumns
            MsgBox strMessage
            strMessage = vbNullString
        End If
    Loop Until rng Is Nothing
ExitSub:
    Set rng = Nothing
    lngColumns = Empty
    strMessage = vbNullString
    Set rngFirstOccurrence = Nothing
    
End Sub

Display More

yegarboy

Professional

Points

3,685

Posts

631
Aug 4th 2010
- #10
Re: Continue loop code until all occurrences of search term are found

Ok thanks i will try it now.
[SIZE=3]The Only Dumb Question Is A Question Not Asked.[/SIZE]
yegarboy

Professional

Points

3,685

Posts

631
Aug 4th 2010
- #11
Re: Continue loop code until all occurrences of search term are found

Ok i see what its doing SMC.
Its freezing only if there is 1 match.
If i put in "Water" it will return all that contain water.
But if i search for a key word that there is only 1 of it goes into endless loop. What i mean by that is....you can press the ok button 1,000 times and the same msgbox keeps pooping up endlessly with out the option to close.
[SIZE=3]The Only Dumb Question Is A Question Not Asked.[/SIZE]

Aug 4th 2010

#12

Re: Continue loop code until all occurrences of search term are found

Try this one instead...

Code

Sub FindLoopAll()


    Dim rng As Range
    Dim rngFirstOccurrence As Range
    Dim lngColumns As Long
    Dim strMessage As String
    Dim varSearchValue
    
    varSearchValue = InputBox("Please enter your search parameter.", "Search...", "Text Here")
    On Error Resume Next
    Set rngFirstOccurrence = Range("E7:E1500").Find(What:=varSearchValue) ', LookAt:=xlwhole
    Debug.Print rngFirstOccurrence.Address
    If Not rngFirstOccurrence Is Nothing Then
        For lngColumns = -3 To 3 'This will show the previous 3, current and next 3 cells of the row
            strMessage = strMessage & rngFirstOccurrence.Offset(, lngColumns).Value & vbCrLf
        Next lngColumns
        MsgBox strMessage
        strMessage = vbNullString
    Else
        MsgBox "No Match Found!"
        GoTo ExitSub
    End If
    
    Do
        Set rng = Nothing
        Set rng = Range("E7:E1500").FindNext(rngFirstOccurrence)
        If rng.Row <= rngFirstOccurrence.Row Then
            Exit Do
        End If
        Debug.Print rng.Address
        Err.Clear: On Error GoTo -1: On Error GoTo 0
        
        If Not rng Is Nothing Then
            Set rngFirstOccurrence = Nothing
            Set rngFirstOccurrence = rng
            For lngColumns = -3 To 3 'This will show the previous 3, current and next 3 cells of the row
                strMessage = strMessage & rng.Offset(, lngColumns).Value & vbCrLf
            Next lngColumns
            MsgBox strMessage
            strMessage = vbNullString
        End If
    Loop Until rng Is Nothing
ExitSub:
    Set rng = Nothing
    lngColumns = Empty
    strMessage = vbNullString
    Set rngFirstOccurrence = Nothing
    
End Sub

Display More

yegarboy

Professional

Points

3,685

Posts

631
Aug 4th 2010
- #13
Re: Continue loop code until all occurrences of search term are found

IT'S PERFECT!!!!! Thank you thank you thank you. You just made mine and my boss's day. I love this forum.
God Bless
[SIZE=3]The Only Dumb Question Is A Question Not Asked.[/SIZE]

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!

Register Yourself Login

Share

This site uses cookies. By continuing to browse this site, you are agreeing to our use of cookies. More Details Close

Your browser has JavaScript disabled. If you would like to use all features of this site, it is mandatory to enable JavaScript.