Find Function

[GomaPile]

Hi all, how is everyone doing, it’s been a while since my last post.

Is there someone who’s able to help us that would be super appreciated for our Hospital Uniform Department.

VBA below was found browsing through Google, weblink provided will take you there (it’s safe).

The VBA does what it supposed to do which is find data within the excel, and we did add our bit too.

The VBA is very similar to the build-in FIND FUNCTION that you and I have on all computers today.

Though the difference between the VBA one from Google and build-in FIND FUNCTION both have their Pros & Cons, but we would love to see them All-In-One. Well to be openly 100% honest to everyone, we’re hoping that someone can help us who knows VBA. Anyways, I tried myself – but sadly no luck.

Build-in FIND FUNCTION:

• Pros: goes straight to that cell and cycles through to the next matching info & onwards.
• Cons: doesn’t highlight the cells yellow.

VBA from Google:

• Pros: highlights all matching info in yellow.
• Cons: though it doesn’t go straight to the first cell or cycles through to the next.

Only 3 things we are requesting, if possible, it can be done.

• Highlight all matching cells in Yellow and go to the first highlighted Cell
• The ability to cycle Back and Forth onto the next cell
• Range: only lookup in Columns C and D

'Website https://www.extendoffice.com/documents/excel/5839-excel-search-and-highlight-results.html

Private Sub CommandButton1_Click()

Dim xRg As Range
Dim xFRg As Range
Dim xStrAddress As String
Dim xVrt As Variant

Application.EnableEvents = False
Application.ScreenUpdating = False

Sheets("Orders").Unprotect Password:="test" '---- change the password to your liking's
xVrt = Application.InputBox(prompt:="Search:", Title:="Search Tool...")
If xVrt <> "" Then
Set xFRg = ActiveSheet.Cells.Find(what:=xVrt)
If xFRg Is Nothing Then
MsgBox prompt:="Cannot find this employee", Title:="Search Tool Completed..."
Exit Sub
End If
xStrAddress = xFRg.Address
Set xRg = xFRg
Do
Set xFRg = ActiveSheet.Cells.FindNext(After:=xFRg)
Set xRg = Application.Union(xRg, xFRg)
Loop Until xFRg.Address = xStrAddress
If xRg.Count > 0 Then
xRg.Interior.ColorIndex = 6
If xRsp = vbOK Then xRg.Interior.ColorIndex = xlNone
End If
End If
xRg.Areas(xRg.Areas.Count)(1).Select
Sheets("Orders").Protect Password:="test" '---- change the password to your liking's

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Regards,
Gomapile (NASA2)

 

[Jaafar Tribak]

@Akuini
Thanks very much for following this up, for revising my code and for the suggestion to set a 200 max for the iterations.

I have looked more in depth into this and realised that using the following code section (taken from your initial demo in post#8) is probably not necesary as you are just passing the Union Range to the to_label Sub which doesn't really make any use of it. The main culprit here is the loop which contains two notoriously slow calls namely, Set c = .FindNext(c) and Set xRng = Union(xRng, c).

'FIND ALL BUTTON
    If Not c Is Nothing Then
        Set xRng = c
        sAddress = c.Address
        Do
           Set c = .FindNext(c)
           Set xRng = Union(xRng, c)
        Loop While Not c Is Nothing And c.Address <> sAddress
        to_label (1)
    Else
        to_label (2)
    End If

The alternative you suggested to me in post#37 for making the code run faster (when needing a dynamic count of the matching cells) is good but, it still uses the notorious Union and FindNext in a loop which both terribly slow down the search, hence your proposal to set a max of 200 iterations.

In the end, I decided not to calculate the live found matches in the TextBox1_Change event and left it to the FindAll buttons.

Also, to make the FindAll routine way much faster, I replaced the FindNext and Union calls with the handy Range DisplayFormat.Interior.Color Property.... When I tested it on a UsedRange with 100000 cells, the entire search took less than 4 seconds! Big difference.
I still however have set the 1000000 cells as a max UsedRange, just in case.

'FIND ALL BUTTON
        For Each oFoundCell In oSearchRange
            If oFoundCell.DisplayFormat.Interior.Color = lbl_Color.BackColor Then
                If oFoundCell.FormatConditions(1).Priority = 1& Then
                    iHitsCounter = iHitsCounter + 1&
                    Lbl_Hits.Caption = "Searching..." & iHitsCounter
                End If
            End If
        Next oFoundCell

I have now also added a couple more buttons to add more functionnality (First, Last, and Home buttons) as well as a 'Remember last search' checkbox.

One thing, though—you don't have to put my name on the userform or in the ribbon. Instead, put your name on it. If you continue developing this as an add-in, you can put my name in the ABOUT section as a co-author."

No problem. As per your request, I have just changed the name to 'Custom Find' and added a normal search icon as you can see in the images above .... Having said that, the fundamental nifty idea of using temporary mass CFormatting was yours.

One more thing, today I just learned from YouTube how to insert a button into the Ribbon via XML; it turned out it's not that difficult. So, I will probably incorporate my code into my add-in called "Search deList." Well, it may not be as good as yours, but it will be a nice addition to the Search deList add-in

Yes. It is actually quite easy. I am actually not very familiar with coding the Ribbon\XML but I use the Custom UI for Microsoft which makes it really easy and google is always there if one gets stuck.

I am almost done with the add-in which I will post here later.

Now before I leave, can I ask you a couple of questions regarding the demo workbook I posted (Post#36)

1- On which platforms did you test the code ? (Excel and Windows)
I see from the picture you posted that the userform title bar is not like Windows 10 themed.

2- Did you experience any issues with the HelpContext '?" button that I added to the form title bar? And was there any issues with the Help\About UserForm (Second UserForm)?

3- Did the animated search GIF next to the TextBox behave as expected? Did it nimate at all?
I am always wary of using a WebBrowser control in my forms.


Regards.



.

 

[Akuini]

Also, to make the FindAll routine way much faster, I replaced the FindNext and Union calls with the handy Range DisplayFormat.Interior.Color Property.... When I tested it on a UsedRange with 100000 cells, the entire search took less than 4 seconds! Big difference.
I still however have set the 1000000 cells as a max UsedRange, just in case.

That's a great improvement.

No problem. As per your request, I have just changed the name to 'Custom Find' and added a normal search icon as you can see in the images above .... Having said that, the fundamental nifty idea of using temporary mass CFormatting was yours.

Thank you.

1- On which platforms did you test the code ? (Excel and Windows)
I see from the picture you posted that the userform title bar is not like Windows 10 themed.
I'm using Excel 365 32 bit on Win 10.
Excel option > General > I set Office theme to Black.

2- Did you experience any issues with the HelpContext '?" button that I added to the form title bar? And was there any issues with the Help\About UserForm (Second UserForm)?
When I clicked the button, nothing happened . It supposed to open the second Userform, right?

3- Did the animated search GIF next to the TextBox behave as expected? Did it nimate at all?
I am always wary of using a WebBrowser control in my forms.
Yes, I could see it moving.

 

[Akuini]

I mentioned earlier that I will incorporate this macro 'to find & highlight data' into the Search deList add-in. However, upon further consideration, I believe it's better to create a new add-in that combines both macros. I'll call it the 'Davary Tool.' This tool will also have a macro to copy-paste to visible cells.

For now, the macro is still in the xlsm format instead of xlam for easier testing. I would appreciate it if anyone could test this 'pre-addin' and provide some feedback.

You will find the 'Davary Tab' in the ribbon. Click the 'Find' button to open a Userform that allows you to find and highlight data. With all the buttons in the ribbon, we won't need any buttons on the sheets.

Workbooks for testing only (autocomplete data validation not yet integrated):

Akuini - Davary_Tools_0.7_to_test

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

 

[Akuini]

@Jaafar Tribak
In the new macro I posted above, I decided to use array to count the matching cells. It turned out significantly faster than using Find method.
Tested on about 390K cells with data & match found about 290K, it took only 0,41 seconds.

Sub to_Count()
'count matched words
Dim tx As String
Dim x, va
Dim n As Long

If Find_check2 Then
    If CheckBox3.Value = False Or (CheckBox3.Value And Len(TextBox1.Text) > CLng(TextBox2.Text) - 1) Then
    
        If Not selected_Range Is Nothing Then
            If selected_Range.Cells.Count > 500000 Then
                Label9.Caption = "Range too large"
            Else
        '        Debug.Print selected_Range.Areas.Count
                If selected_Range.Areas.Count = 1 Then
                    va = selected_Range.Value
                    tx = LCase(TextBox1.Text)
                    For Each x In va
                        If LCase(x) Like "*" & tx & "*" Then n = n + 1
                    Next
                    Label9.Caption = n
                Else
                    Label9.Caption = "It's a non-contiguos range"
                End If
            
            End If
        End If
        
    End If
End If
End Sub

 

[Jaafar Tribak]

Hi Akuini,

Thanks for the feedback and suggestions.

Excel option > General > I set Office theme to Black.

I was actually referring to the Windows themes.

When I clicked the button, nothing happened . It supposed to open the second Userform, right?

Yes. The second userform is supposed to open... Does clicking on the ? help menu button changes the mouse cursor icon into a question mark '?"

In the new macro I posted above, I decided to use array to count the matching cells. It turned out significantly faster than using Find method.
Tested on about 390K cells with data & match found about 290K, it took only 0,41 seconds.

Thanks for the code. I will take a look at it later.

For now, the macro is still in the xlsm format instead of xlam for easier testing. I would appreciate it if anyone could test this 'pre-addin' and provide some feedback.

I downloaded your Devary Tools 0.7 to test workbook for testing and I like what I see. The user interface is very tidy and user friendly... And now with the added ribbon, it looks even friendlier and easy to use. Nice!


See your workbook demo with the revised code:
Davary_Tools_0.7_Revised

Couple of sugestions:

1- Organising propper tabbing system for the controls is really important. Maybe you were going to add them later anyway before releasing the add-in.
Also, I would make sure to add accelerator keys to each selectable control... Makes it look more professional and enable keyboard use.

2- I would also add shortcut keys to the main ribbon button. (ie:=Find Button) (I haven't done this before but, I would presume it is doable)

3- I would call clear_Format routine in the to_label SUb as follows.
Private Sub to_label(a As Long)

With Me.Label8
If a = 1 Then
If TextBox1.Text <> "" Then
.Caption = "Found match"
.ForeColor = vbBlue
End If
Else
.Caption = "Nothing found"
.ForeColor = vbRed
'Addition ////////////////////
Call clear_Format
'/////////////////////////////
' Beep 'uncomment this line if you want Beep sound when the search found nothing
End If
End With

End Sub

4- I think It is inevitable that the user will sooner or later forget to select the search range before they open the userform. It already happend to me many times when testing . It is kind of like instinctive.
In order to remove this 'annoying' restriction and thus enable the user to select ranges freely 'before' as well as 'after' they open the userform, I suggest you trap the activesheet events when first loading the userform.

You will need to incorporate a couple of small api calls to tell whether the range selections are being carried out by the code behind the userform navigation buttons or by the user directly selecting the ranges in the worksheet... Therefore, this little api step will avoid duplication of code execution which causes annoying screen flickering.

Also, think of the scenario where the user activates a different worksheet while the userform is on display. This eventuality could cause issues. Fortunately, trapping the Deactivate event can help automatically refresh the userform according to the new current sheet.

So, in summary, I added the following code section at the very top of your userform module:

Option Explicit

'Addition //////////////////////////////////////////////////////////////////
Private WithEvents WshEvents As Worksheet
#If VBA7 Then
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
#Else
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As Long) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
#End If
'//////////////////////////////////////////////////////////////////


'Addition //////////////////////////////////////////////////////////////////

' _______________________________________ ActiveSheet Events ______________________________________

Private Sub WshEvents_Deactivate()

    'This step is to prevent havoc when user selects new sheet
    'while the modeless form is still showing
    Call clear_Format
    Unload Me
    Call toShow__Davary
 
End Sub

Private Sub WshEvents_SelectionChange(ByVal Target As Range)

    'This step is to remove the restriction of the having to select the range before open the userform
    'With this, the user can select the range either 'before' as well as 'after' open the userform

    #If VBA7 Then
        Dim hwnd As LongPtr
    #Else
        Dim hwnd As Long
    #End If
    Call IUnknown_GetWindow(Me, VarPtr(hwnd))
    If GetActiveWindow <> hwnd Then
        If Intersect(Selection.Cells, ActiveSheet.UsedRange).Cells.Count = 1& Then
            Set selected_Range = ActiveSheet.UsedRange
            Call to_Format
        Else
            Set selected_Range = Selection
            Call to_Format
        End If
    End If

End Sub

And then I added this at the very bottom of the UserForm_Initialize event:

    'Addition //////////////////////////////////////////////////////////////////
    Set WshEvents = ActiveSheet  '<< trap the activesheet events here.
    '///////////////////////////////////////////////////////////////////////////

5- Finally, think ahead of what issues you may encounter with multiple open workbooks when the code is ready and used as an add-in .

I will take another look later tonight to see if I can find any bugs or offer some further suggestions.

Regards.

 

[Akuini]

@Jaafar Tribak
Thanks for the feedback, I'll review it tomorrow.

 

[Alex Blakenburg]

I saw a couple of references to speed and @Akuini reference to using an array in post #43.
Are we doing the same loop multiple times ?
• to_count
• TextBox1_Change()
• CommandButton1_Click
Can't we store the TextBox1 value for xRng as a public variable since it precedes the CommandButton1_Click, and reuse it.

Would using an array instead of find to create the Union not be faster eg:
(assumes the test for a contiguous range is still performed)

Private Sub CommandButton1_Click()
    'FIND ALL BUTTON
    Dim c As Range
    Dim sAddress As String
   
    'txA = LCase(TextBox1.Text)
    If txA = "" Then Exit Sub
    'clear_Format
    Set xRng = Nothing
   
    Dim selected_Arr As Variant
    Dim selected_Row1 As Long, selected_Col1 As Long, iRow As Long, iCol As Long, iCnt As Long
   
    selected_Arr = selected_Range.Value
    selected_Row1 = selected_Range.Row
    selected_Col1 = selected_Range.Column

    For iRow = 1 To UBound(selected_Arr, 1)
        For iCol = 1 To UBound(selected_Arr, 2)
            If InStr(1, selected_Arr(iRow, iCol), txA, vbTextCompare) Then
                iCnt = iCnt + 1
                If xRng Is Nothing Then
                    Set xRng = Cells(selected_Row1 + iRow - 1, selected_Col1 + iCol - 1)
                Else
                    Set xRng = Union(xRng, Cells(selected_Row1 + iRow - 1, selected_Col1 + iCol - 1))
                End If
            End If
        Next iCol
    Next iRow

    If Not xRng Is Nothing Then
        xRng.Activate
    End If
End Sub

 

[Akuini]

@Jaafar Tribak
1- Organising propper tabbing system for the controls is really important. Maybe you were going to add them later anyway before releasing the add-in.
Thanks, I forgot about this.

Also, I would make sure to add accelerator keys to each selectable control... Makes it look more professional and enable keyboard use.
I've never done this before, I'll look into it.

2- I would also add shortcut keys to the main ribbon button. (ie:=Find Button) (I haven't done this before but, I would presume it is doable)
I've never done this before, I'll look into it.

3- I would call clear_Format routine in the to_label SUb as follows.

That's probably a good idea, but honestly, as the code became more complex, I sometimes lose track of the code flow. Basically, the main place to call 'clear_Format' is in 'Textbox1_change,' so I need to check if putting 'clear_Format' into 'to_label' is not redundant. Also, as you can see in my last macro, I've removed 'Sub Find_All' along with the button. I don't think we need to get the range of all matching cells because 'CFormat' does the job to highlight them. So, what we need is how to navigate through them. And this is done by using the 'Find' method with 'xlNext' and 'xlPrevious' arguments (without needing to find all matching cells).

4- I think It is inevitable that the user will sooner or later forget to select the search range before they open the userform. It already happend to me many times when testing . It is kind of like instinctive.
In order to remove this 'annoying' restriction and thus enable the user to select ranges freely 'before' as well as 'after' they open the userform, I suggest you trap the activesheet events when first loading the userform.

You will need to incorporate a couple of small api calls to tell whether the range selections are being carried out by the code behind the userform navigation buttons or by the user directly selecting the ranges in the worksheet... Therefore, this little api step will avoid duplication of code execution which causes annoying screen flickering.

Sorry, I've never used an API code before; it's beyond my knowledge. I'm not comfortable using code that I don't understand in my project, except when it's really necessary.

But, of course, feel free to apply API codes in your project.
And I've been thinking that you are more than capable of writing this project from scratch. I mean, writing a code based on someone else's code usually is harder than writing it by ourselves. So, if you think that's the case, just forget about my code.

5- Finally, think ahead of what issues you may encounter with multiple open workbooks when the code is ready and used as an add-in .
Good point, I haven't thought about that.

I really appreciate your input. Thanks a lot.

 

[Akuini]

@Alex Blakenburg

Also, as you can see in my last macro, I've removed 'Sub Find_All' along with the button. I don't think we need to get the range of all matching cells because 'CFormat' does the job to highlight them. So, what we need is how to navigate through them. And this is done by using the 'Find' method with 'xlNext' and 'xlPrevious' arguments (without needing to find all matching cells).

 

[Akuini]

@Alex Blakenburg
Could you test my latest macro in post #43? I'm attempting to incorporate this macro into an add-in, so I need feedback to identify bugs and gather ideas for improving its functionality and performance.