Thanks, Aaron,
A really neat X-mas gift. Much appreciated.
Tom
| Ozgrid Excel Help Forums & Excel Best Practices |
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...
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.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
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:
Clear the range if the cell contains exactly 999, but if it's a formula leave it be:Code:Find_Range(22, Range("D10:G20")).Select
Delete all rows that contain "X" in column A:Code:Find_Range(999, Range("D10:G20"), xlFormulas, xlWhole).ClearContents
Quickly scan the whole sheet if you like!Code:Find_Range("X", Columns("A"), MatchCase:=True).EntireRow.Delete
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 at 09:07.
Sub All_Macros(Optional control As Variant)
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.
Better than a Taun-taun Aaron!!
Pretty cool!
Regards,
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
Cool indeed Aaron, thanks for sharing!
Is there anyway to use this with a number that is not fixed? Such as anything greater than 5000?
Thanks,
Josh
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
Sub All_Macros(Optional control As Variant)
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
Good idea Ivan.Originally Posted by Ivan F Moala
I think I'll incorporate the Enum as well.
Sub All_Macros(Optional control As Variant)
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!!!!
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks