Announcement

Collapse
No announcement yet.

Kickbutt VBA Find Function

Collapse
This topic is closed.
X
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Kickbutt VBA Find Function



    A Christmas treat for my OZgrid friends.

    Wraping the VBA Find/FindNext methods into a function you can use in your code to return found range objects!

    This function is awesome, and the uses are many...

    Code:
    Function Find_Range(Find_Item As Variant, _ 
        Search_Range As Range, _ 
        Optional LookIn As Variant, _ 
        Optional LookAt As Variant, _ 
        Optional MatchCase As Boolean) As Range 
         
        Dim c As Range 
        If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
        If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
        If IsMissing(MatchCase) Then MatchCase = False 
         
        With Search_Range 
            Set c = .Find( _ 
            What:=Find_Item, _ 
            LookIn:=LookIn, _ 
            LookAt:=LookAt, _ 
            SearchOrder:=xlByRows, _ 
            SearchDirection:=xlNext, _ 
            MatchCase:=MatchCase, _ 
            SearchFormat:=False) 
            If Not c Is Nothing Then 
                Set Find_Range = c 
                firstAddress = c.Address 
                Do 
                    Set Find_Range = Union(Find_Range, c) 
                    Set c = .FindNext(c) 
                Loop While Not c Is Nothing And c.Address <> firstAddress 
            End If 
        End With 
         
    End Function
    This should work in 2002 and later. You may have to tweak it a bit to work with earlier versions. For instance, I don't think SearchFormat is an option for the FIND method in 2000 and earlier. You can wipe that line if needed.


    Here's just a few of the potential uses for this function...

    Select all cells in a range that contain 22 as part of the value:
    Code:
    Find_Range(22, Range("D10:G20")).Select
    Clear the range if the cell contains exactly 999, but if it's a formula leave it be:
    Code:
    Find_Range(999, Range("D10:G20"), xlFormulas, xlWhole).ClearContents
    Delete all rows that contain "X" in column A:
    Code:
    Find_Range("X", Columns("A"), MatchCase:=True).EntireRow.Delete
    Quickly scan the whole sheet if you like!
    Code:
    Find_Range(1000, Cells, xlFormulas, xlWhole).EntireRow.Select

    How often have you seen people asking, "How do I find all rows that match a criteria and paste the results to a new sheet?" Now you can do it in a single line of code. For those who can appreciate it, this last one is pretty amazing!

    Copy all the rows that have the value 1000 in column D and paste to Sheet2:
    Find_Range(1000, Columns("D"), xlFormulas, xlWhole).EntireRow.Copy Range("Sheet2!A1")
    Last edited by Dave Hawley; January 21st, 2010, 10:07.
    Sub All_Macros(Optional control As Variant)

  • #2
    Re: Kickbutt VBA Find Function

    Thanks, Aaron,

    A really neat X-mas gift. Much appreciated.

    Tom
    Best Regards,
    Tom
    ---------------------------
    Please help Oz share knowledge among all users by posting your questions in a public forum rather than using a Private Message.

    Comment


    • #3
      Re: Kickbutt VBA Find Function

      Better than a Taun-taun Aaron!!

      Pretty cool!

      Regards,
      Brandtrock

      Brandtrock Consulting | Brandtrock Files | ISU Athletics | Bricktown | VBA Express

      Comment


      • #4
        Re: Kickbutt VBA Find Function

        And for the truly brave, you could even do a find/copy/paste-append to a different sheet as a one-liner!

        Find_Range(1000, Columns("D"), xlFormulas, xlWhole).EntireRow.Copy Range("Sheet2!D65536").End(xlUp).Offset(1, 0).EntireRow


        I tested this one on a 10,000 dataset and for 100 finds in the 10,000 block it was nearly instantaneous. On 65,536 records with 650 finds it took less than 5 seconds.


        This next one is a tad abstract, but if you need to perform the above operation and search multiple columns the one-liner above MIGHT (yes it depends) fail if I just changed the columns reference to "A:D". In this case, a union would take care of it.

        Set Found_Range = Find_Range(1000, Columns("A:D"), xlFormulas, xlWhole).EntireRow
        Union(Found_Range, Found_Range).Copy Range("Sheet2!A65536").End(xlUp).Offset(1, 0).EntireRow


        In this case, the union is resolving overlapping range issues created because a matching value was found in multiple columns of the same row. If there are no instances of the found item existing in multiple columns of the same row, this is not an issue. Notice for the above example this works:
        Union(Found_Range, Found_Range).Copy

        While this alone would fail:
        Found_Range.Copy

        That is, it would fail if there were multiple occurances of the value within the row.

        Similarly, you can imagine how you'd have to also use the union if you were returning entire columns with this function.

        Enjoy!
        -AB
        Sub All_Macros(Optional control As Variant)

        Comment


        • #5
          Re: Kickbutt VBA Find Function

          Cool indeed Aaron, thanks for sharing!

          Comment


          • #6
            Re: Kickbutt VBA Find Function

            Is there anyway to use this with a number that is not fixed? Such as anything greater than 5000?

            Thanks,
            Josh

            Comment


            • #7
              Re: Kickbutt VBA Find Function

              Not really... it works just like the find feature on the menu toolbar. There are other VBA methods you can use to test cell values.


              Originally posted by jwaldon
              Is there anyway to use this with a number that is not fixed? Such as anything greater than 5000?

              Thanks,
              Josh
              Sub All_Macros(Optional control As Variant)

              Comment


              • #8
                Re: Kickbutt VBA Find Function

                Hi Aaron, just a couple of things;

                1) FirstAddress wasn't defined.

                2) I like to use functions where you are given choices rather then guess @ the expected values i.e LookIn = xlValues 'xlFormulas the use wil be expected to places these constant in.

                To this end (For Excel2000+) I use Enum like so ......
                With Enum writing the Code gives the user intellisence options for the Consts.

                Don't take this the wrong way, it is a nice function... one that I will use

                Any way for xl2000+ this is how I will use it >

                Code:
                Enum eLookin
                    xl_Formulas = -4123
                    xl_Comments = -4144
                    xl_Values = -4163
                End Enum
                
                Enum eLookat
                    xl_Part = 2
                    xl_Whole = 1
                End Enum
                
                Function Find_Range(Find_Item As Variant, _
                    Search_Range As Range, _
                    Optional LookIn As eLookin, _
                    Optional LookAt As eLookat, _
                    Optional MatchCase As Boolean) As Range
                     
                    Dim c As Range, FirstAddress As String '<<
                    
                    If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
                    If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
                    If IsMissing(MatchCase) Then MatchCase = False
                      
                    With Search_Range
                        Set c = .Find( _
                            What:=Find_Item, _
                            LookIn:=LookIn, _
                            LookAt:=LookAt, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=MatchCase, _
                            SearchFormat:=False)
                        If Not c Is Nothing Then
                            Set Find_Range = c
                            FirstAddress = c.Address
                            Do
                                Set Find_Range = Union(Find_Range, c)
                                Set c = .FindNext(c)
                            Loop While Not c Is Nothing And c.Address <> FirstAddress
                        End If
                    End With
                     
                End Function
                Kind Regards,
                Ivan F Moala From the City of Sails

                http://www.xcelfiles.com

                Comment


                • #9
                  Re: Kickbutt VBA Find Function

                  Originally posted by Ivan F Moala
                  Hi Aaron, just a couple of things;

                  1) FirstAddress wasn't defined.

                  2) I like to use functions where you are given choices rather then guess @ the expected values i.e LookIn = xlValues 'xlFormulas the use wil be expected to places these constant in.

                  To this end (For Excel2000+) I use Enum like so ......
                  With Enum writing the Code gives the user intellisence options for the Consts.

                  Don't take this the wrong way, it is a nice function... one that I will use
                  Good idea Ivan.
                  I think I'll incorporate the Enum as well.
                  Sub All_Macros(Optional control As Variant)

                  Comment


                  • #10
                    Re: Kickbutt VBA Find Function

                    Is there a quick one liner that would take out all the lines starting with a string (word?) or symbols ("----")? if so what should I put at the the place "what"?

                    Find_Range(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)


                    Thanks for the great code. I'll use it a lot!!!!

                    Comment


                    • #11
                      Re: Kickbutt VBA Find Function

                      Code:
                      'WILDCARD Searching
                      'The only wildcards I've noticed that are supported by the FIND or FINDNEXT
                      'methods are "*" and "?" where the asterisk is any group of characters and the
                      'q-mark is any single character.  Oddly enough, the commonly used "#" and "@"
                      'wildcards are not supported; makes searching for any number or letter a little
                      'challenging.
                      
                      'Example 14
                      'Find any text or numerical entry in a range.
                      Sub Ex_14()
                          x = "*"
                          Find_Range(x, Sheet1.Columns("B"), xlValues, xlWhole).Select
                      End Sub
                      
                      'Example 15
                      'Find all cells that contain a number.  In this case we have to loop 10 times
                      'to search for the existance of each number.
                      Sub Ex_15()
                          Dim Found_Range As Range
                          On Error Resume Next
                          a = 0
                          b = 9
                          For i = a To b
                              x = "*" & i & "*"
                              If i = a Then
                                  Set Found_Range = Find_Range(x, Cells, xlValues, xlWhole)
                              Else
                                  Set Found_Range = Union(Found_Range, Find_Range(x, Cells, xlValues, xlWhole))
                              End If
                          Next i
                          Found_Range.Select
                      End Sub
                      
                      'Example 16
                      'Find any text or value entry that has a text length of 4 characters.
                      Sub Ex_16()
                          x = "????"
                          Find_Range(x, Sheet1.Columns("B"), xlValues, xlWhole).Select
                      End Sub
                      
                      'Example 17
                      'Find all cells that contain letters of the alphabet.
                      Sub Ex_17()
                          Dim Found_Range As Range
                          On Error Resume Next
                          a = 65
                          b = 90
                          For i = a To b
                              x = "*" & Chr(i) & "*"
                              If i = a Then
                                  Set Found_Range = Find_Range(x, Cells, xlValues, xlWhole)
                              Else
                                  Set Found_Range = Union(Found_Range, Find_Range(x, Cells, xlValues, xlWhole))
                              End If
                          Next i
                          Found_Range.Select
                      End Sub
                      
                      'Example 18
                      'Find all cells that START with a letter of the alphabet.
                      Sub Ex_18()
                          Dim Found_Range As Range
                          On Error Resume Next
                          a = 65
                          b = 90
                          For i = a To b
                              x = Chr(i) & "*"
                              If i = a Then
                                  Set Found_Range = Find_Range(x, Cells, xlValues, xlWhole)
                              Else
                                  Set Found_Range = Union(Found_Range, Find_Range(x, Cells, xlValues, xlWhole))
                              End If
                          Next i
                          Found_Range.Select
                      End Sub
                      Sub All_Macros(Optional control As Variant)

                      Comment


                      • #12
                        Re: Kickbutt VBA Find Function

                        Code:
                        Sub Dele()
                        Code:
                        Find_Range("-", Range("A1:A60000")).EntireRow.Delete
                        Code:
                        Find_Range("Caepipe", Range("A1:A60000")).EntireRow.Delete
                        Code:
                        End Sub

                        I wrote a little sub to take away useless lines in files utilizing the Find_Range function. This function is great!!! When I run the code there's an error saying :
                        Run-time error '91':
                        Object variable or With Block variable not set

                        What should I do? what's wrong?

                        Comment


                        • #13
                          Re: Kickbutt VBA Find Function

                          I notice you're leaving the optional variables empty. That's fine if you use my original code, but you might get an error if you tried to use Ivan's enumeration suggestion without modifying the IsMissing tests to test for zero instead. I just now noticed his code didn't include that change.

                          I liked Ivan's enumeration idea, so I updated the example on my website to include it. But because you redefine the input parameters as enumerations, they will never trip the IsMissing test. This is how I incorporated the enumeration suggestion.

                          Code:
                          'This should work fine in XL2002 and later.
                          'You may have to tweak it a bit to work with earlier versions.
                          'For instance, I'm told SearchFormat is not an option for the
                          'FIND method in XL2000 and earlier. You can wipe that line if needed.
                          Enum eLookin
                              xlFormulas = -4123
                              xlComments = -4144
                              xlValues = -4163
                          End Enum
                           
                          Enum eLookat
                              xlPart = 2
                              xlWhole = 1
                          End Enum
                          
                          Function Find_Range(Find_Item As Variant, _
                              Search_Range As Range, _
                              Optional LookIn As eLookin, _
                              Optional LookAt As eLookat, _
                              Optional MatchCase As Boolean) As Range
                               
                              Dim c As Range, FirstAddress As String
                              If LookIn = 0 Then LookIn = xlValues
                              If LookAt = 0 Then LookAt = xlPart
                              If IsMissing(MatchCase) Then MatchCase = False
                               
                              With Search_Range
                                  Set c = .Find( _
                                  What:=Find_Item, _
                                  LookIn:=LookIn, _
                                  LookAt:=LookAt, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, _
                                  MatchCase:=MatchCase, _
                                  SearchFormat:=False)   'Delete this term for XL2000 and earlier
                                  If Not c Is Nothing Then
                                      Set Find_Range = c
                                      FirstAddress = c.Address
                                      Do
                                          Set Find_Range = Union(Find_Range, c)
                                          Set c = .FindNext(c)
                                      Loop While Not c Is Nothing And c.Address <> FirstAddress
                                  End If
                              End With
                               
                          End Function

                          Also, in your code.
                          Code:
                          Find_Range("-", Range("A1:A60000")).EntireRow.Delete
                          I'd probably just refer to the entire column A in one of the following ways.
                          Code:
                          Find_Range("-", Range("A:A")).EntireRow.Delete 
                          Find_Range("-", [A:A]).EntireRow.Delete 
                          Find_Range("-", Columns("A")).EntireRow.Delete
                          Sub All_Macros(Optional control As Variant)

                          Comment


                          • #14
                            Re: Kickbutt VBA Find Function

                            Quick question, I want the whole thing to run as a button click, do i put the whole code into the button? as in do i do the following
                            Code:
                            Private Sub CommandButton1_Click()
                            Function Find_Range(Find_Item As Variant, _
                                Search_Range As Range, _
                                Optional LookIn As Variant, _
                                Optional LookAt As Variant, _
                                Optional MatchCase As Boolean) As Range
                                 
                                Dim c As Range
                                If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
                                If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
                                If IsMissing(MatchCase) Then MatchCase = False
                                 
                                With Search_Range
                                    Set c = .Find( _
                                    What:=Find_Item, _
                                    LookIn:=LookIn, _
                                    LookAt:=LookAt, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=MatchCase, _
                                    SearchFormat:=False)
                                    If Not c Is Nothing Then
                                        Set Find_Range = c
                                        firstAddress = c.Address
                                        Do
                                            Set Find_Range = Union(Find_Range, c)
                                            Set c = .FindNext(c)
                                        Loop While Not c Is Nothing And c.Address <> firstAddress
                                    End If
                                End With
                                 
                            End Function
                             
                             Find_Range("0", Columns("A"), MatchCase:=True).EntireRow.Delete
                            End Sub
                            If that is correct is said there was an error at
                            Code:
                            SearchFormat:=False)
                            I couldnt understand why it came there?

                            Comment


                            • #15


                              Re: Kickbutt VBA Find Function

                              I'm a doughnut, i figured it out (with a lil help from my manager)

                              Comment

                              Working...
                              X