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)

 

[NdNoviceHlp]

Hi Gomapile. You can trial this. I have no idea what "ability to cycle back and forth onto the next cell" means? So this code won't do that. HTH. Dave

Private Sub CommandButton1_Click()
Dim xRg As Range, RngFind As Range
Dim xVrt As String

xVrt = Application.InputBox(prompt:="Search:", Title:="Search Tool...")
If xVrt = "" Then
MsgBox "Enter Something!"
Exit Sub
End If

On Error GoTo ErFix
Application.EnableEvents = False
Application.ScreenUpdating = False
Sheets("Orders").Unprotect Password:="test" '---- change the password to your liking's

With Sheets("Orders")
LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
Set RngFind = .Range(.Cells(1, "C"), .Cells(LastRow, "D"))
RngFind.Interior.ColorIndex = xlColorIndexNone
End With
Flag = False
For Each xRg In RngFind
If xRg.Value = xVrt Then
    If Not Flag Then
    Flag = True
    xRg.Select
    End If
xRg.Interior.ColorIndex = 6
End If
Next xRg

Sheets("Orders").Protect Password:="test" '---- change the password to your liking's
ErFix:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[GomaPile]

Hey NdNovieHlp,

Thanks for replying to my post and we're sorry also for the long delay getting back as well too.

We can learn a lot from your VBA you wrote.. thanks.

Anyhow, we tried yours, though it doesn't take you straight to the first highlighted yellow cell. The attached image below is what we been using before.

1). would it possible to add 2 buttons that says: FIND NEXT (going forward) and PREVIOUS (going backwards).
2). then if there is no matching data then display: MsgBox prompt:="Cannot find this employee", Title:="Search Tool Completed..."

With the "ability to cycle back and forth" question, what I mean by this...
When using the keyboard "Ctrl F" it opens your built-in Find and Replace function, then we click "Find Next" where it takes you straight to that cell, repeat clicking it again, moves to the next cell... so on and so on, until the end of the active spreadsheet.

Regards,
Nasa2 (Gomapile)

 

[Akuini]

With the "ability to cycle back and forth" question, what I mean by this...
When using the keyboard "Ctrl F" it opens your built-in Find and Replace function, then we click "Find Next" where it takes you straight to that cell, repeat clicking it again, moves to the next cell... so on and so on, until the end of the active spreadsheet.

You need a UserForm to emulate this behavior. If it's okay for you to use a userform then I can try to write the code.

 

[NdNoviceHlp]

Hi again Nasa2. The code doesn't take you to the first highlighted cell but it does select the first highlighted cell.... not sure how to change that. Here's some code if you want to use 2 buttons to go forward to select the next highlighted cell or backwards to select the previous highlighted cell. Perhaps the code will be useful if Akuini want to assist with the development of a userform. HTH. Dave
sheet code..,

Option Explicit
Dim Arr() As Variant
Private Sub CommandButton1_Click()
'find first match in range
Call FindIt
End Sub

Private Sub CommandButton2_Click()
'next
Dim cnt As Integer, Flag As Boolean
If ((Not Not Arr) = 0) Then
MsgBox "No matches"
Exit Sub
End If
Flag = False
For cnt = LBound(Arr) To UBound(Arr) - 1
If ActiveCell.Address = Arr(cnt) Then
If cnt = UBound(Arr) - 1 Then
'Sheets("Orders").Unprotect Password:="test" '---- change the password to your liking's
Range(Arr(cnt)).Select
Exit Sub
End If
'Sheets("Orders").Unprotect Password:="test" '---- change the password to your liking's
Range(Arr(cnt + 1)).Select
Flag = True
Exit For
End If
Next cnt
If Not Flag Then
MsgBox "No Previous Selection"
Call FindIt
End If
End Sub

Private Sub CommandButton3_Click()
'previous
Dim cnt As Integer, Flag As Boolean
If ((Not Not Arr) = 0) Then
MsgBox "No matches"
Exit Sub
End If
Flag = False
For cnt = LBound(Arr) To UBound(Arr) - 1
If ActiveCell.Address = Arr(cnt) Then
If cnt = LBound(Arr) Then
'Sheets("Orders").Unprotect Password:="test" '---- change the password to your liking's
Range(Arr(cnt)).Select
'Sheets("Orders").Protect Password:="test" '---- change the password to your liking's
Exit Sub
End If
'Sheets("Orders").Unprotect Password:="test" '---- change the password to your liking's
Range(Arr(cnt - 1)).Select
'Sheets("Orders").Protect Password:="test" '---- change the password to your liking's
Flag = True
Exit For
End If
Next cnt
If Not Flag Then
MsgBox "No Previous Selection"
Call FindIt
End If
End Sub

Sub FindIt()
'find first match in range
Dim xRg As Range, RngFind As Range, Flag As Boolean, LastRow As Integer
Dim xVrt As String, Arrcnt As Integer
xVrt = Application.InputBox(prompt:="Search:", Title:="Search Tool...")
If xVrt = "" Then
MsgBox "Enter Something!"
Exit Sub
End If

On Error GoTo ErFix
Application.EnableEvents = False
Application.ScreenUpdating = False
Erase Arr
Arrcnt = 0

'Sheets("Orders").Unprotect Password:="test" '---- change the password to your liking's
With Sheets("Orders")
LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
Set RngFind = .Range(.Cells(1, "C"), .Cells(LastRow, "D"))
RngFind.Interior.ColorIndex = xlColorIndexNone
End With
Flag = False
For Each xRg In RngFind
If xRg.Value = xVrt Then
    If Not Flag Then
    Flag = True
    xRg.Select
    End If
Arrcnt = Arrcnt + 1
ReDim Preserve Arr(Arrcnt)
Arr(Arrcnt - 1) = xRg.Address
xRg.Interior.ColorIndex = 6
End If
Next xRg

'Sheets("Orders").Protect Password:="test" '---- change the password to your liking's
ErFix:
If Err.Number <> 0 Then
MsgBox "error"
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[GomaPile]

You need a UserForm to emulate this behavior. If it's okay for you to use a userform then I can try to write the code.

Good morning Akuini,

Wasn't here last Friday on a RDO and I don't work the weekends also. After reading your post this morning we would absolutely love your assistant please. Funny thing mentioned this to our staff, and they were supervised to see we have good & honest people willing to help.

Friend: I would like to say thank you on in advance on behave of our hospital in Queensland, we're all excited and pleased seeing the outcome progress along.


Regards,
Nasa2 (Gomapile)

 

[GomaPile]

Hi again Nasa2. The code doesn't take you to the first highlighted cell but it does select the first highlighted cell.... not sure how to change that. Here's some code if you want to use 2 buttons to go forward to select the next highlighted cell or backwards to select the previous highlighted cell. Perhaps the code will be useful if Akuini want to assist with the development of a userform. HTH. Dave
sheet code..,

Option Explicit
Dim Arr() As Variant
Private Sub CommandButton1_Click()
'find first match in range
Call FindIt
End Sub

Private Sub CommandButton2_Click()
'next
Dim cnt As Integer, Flag As Boolean
If ((Not Not Arr) = 0) Then
MsgBox "No matches"
Exit Sub
End If
Flag = False
For cnt = LBound(Arr) To UBound(Arr) - 1
If ActiveCell.Address = Arr(cnt) Then
If cnt = UBound(Arr) - 1 Then
'Sheets("Orders").Unprotect Password:="test" '---- change the password to your liking's
Range(Arr(cnt)).Select
Exit Sub
End If
'Sheets("Orders").Unprotect Password:="test" '---- change the password to your liking's
Range(Arr(cnt + 1)).Select
Flag = True
Exit For
End If
Next cnt
If Not Flag Then
MsgBox "No Previous Selection"
Call FindIt
End If
End Sub

Private Sub CommandButton3_Click()
'previous
Dim cnt As Integer, Flag As Boolean
If ((Not Not Arr) = 0) Then
MsgBox "No matches"
Exit Sub
End If
Flag = False
For cnt = LBound(Arr) To UBound(Arr) - 1
If ActiveCell.Address = Arr(cnt) Then
If cnt = LBound(Arr) Then
'Sheets("Orders").Unprotect Password:="test" '---- change the password to your liking's
Range(Arr(cnt)).Select
'Sheets("Orders").Protect Password:="test" '---- change the password to your liking's
Exit Sub
End If
'Sheets("Orders").Unprotect Password:="test" '---- change the password to your liking's
Range(Arr(cnt - 1)).Select
'Sheets("Orders").Protect Password:="test" '---- change the password to your liking's
Flag = True
Exit For
End If
Next cnt
If Not Flag Then
MsgBox "No Previous Selection"
Call FindIt
End If
End Sub

Sub FindIt()
'find first match in range
Dim xRg As Range, RngFind As Range, Flag As Boolean, LastRow As Integer
Dim xVrt As String, Arrcnt As Integer
xVrt = Application.InputBox(prompt:="Search:", Title:="Search Tool...")
If xVrt = "" Then
MsgBox "Enter Something!"
Exit Sub
End If

On Error GoTo ErFix
Application.EnableEvents = False
Application.ScreenUpdating = False
Erase Arr
Arrcnt = 0

'Sheets("Orders").Unprotect Password:="test" '---- change the password to your liking's
With Sheets("Orders")
LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
Set RngFind = .Range(.Cells(1, "C"), .Cells(LastRow, "D"))
RngFind.Interior.ColorIndex = xlColorIndexNone
End With
Flag = False
For Each xRg In RngFind
If xRg.Value = xVrt Then
    If Not Flag Then
    Flag = True
    xRg.Select
    End If
Arrcnt = Arrcnt + 1
ReDim Preserve Arr(Arrcnt)
Arr(Arrcnt - 1) = xRg.Address
xRg.Interior.ColorIndex = 6
End If
Next xRg

'Sheets("Orders").Protect Password:="test" '---- change the password to your liking's
ErFix:
If Err.Number <> 0 Then
MsgBox "error"
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Good morning NdNovieHlp,

We thank you for your assisting, as well. If it wasn't for your 1st replay this post wouldn't have lifted off the ground, and we need to acknowledge that too.
Anyway, I tried you vba code that you wrote - did very simple search either using text, numbers etc, but nothing actually highlighted.

Kind Regards,
Nasa2 (Gomapile)

 

[Akuini]

Wasn't here last Friday on a RDO and I don't work the weekends also. After reading your post this morning we would absolutely love your assistant please.

Here's an example of a macro to find and highlight data via a userform.
Features:

1. Partial match search only.
2. Case-insensitive only.
3. Highlights matching cells
4. Uses Conditional Formatting instead of changing cell interior color, so it won't affect any cell's interior color.
5. Provides an option to keep or remove the highlight when exiting the Userform via a checkbox.
6. If you select a single cell, the entire sheet will be searched.
7. If you select multiple cells, only the selected range will be searched.

To keep the highlight when exiting the Userform, uncheck the "Remove highlighting on exit" checkbox. To remove the highlight, open the userform again, check the checkbox, and then exit.
The code creates Conditional Formatting and then deletes it when it's no longer needed.
The code uses a specific color for highlighting (via Conditional Formatting), which is set in this part:
' Set the color for highlighting (RGB style).
' Do not use this specific color for any other Conditional Format, as it may get deleted.
Private Const Rgb1 As Long = 253
Private Const Rgb2 As Long = 250
Private Const Rgb3 As Long = 55

The workbook:

Akuini - Find & Highlight via Userform

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

The code:

Option Explicit
Private xRng As Range
Private selected_Range As Range
Private txA As String

' set color for highlighting (RGB style)
' do not use this specific color on any other Conditional Format otherwise they can get deleted
Private Const Rgb1 As Long = 253
Private Const Rgb2 As Long = 250
Private Const Rgb3 As Long = 55

Private Sub CheckBox1_Click()
    xCheck = CheckBox1.Value
End Sub

Private Sub TextBox1_Change()
    txA = Trim(TextBox1.Text)
    If txA <> "" Then
        Call to_Format
    Else
        Call clear_Format
    End If
    to_label (1)
End Sub


Private Sub UserForm_Initialize()

CommandButton1.Caption = "FIND ALL"
CommandButton2.Caption = "PREV"
CommandButton3.Caption = "NEXT"
Label1.Caption = "Find What:"
CheckBox1.Value = xCheck
CheckBox1.Caption = "Remove highlighting on exit"

    If Selection.Cells.CountLarge = 1 Then
        Set selected_Range = ActiveSheet.UsedRange
    Else
        Set selected_Range = Selection.Cells
    End If
    
    
End Sub

Sub to_Format()
Call clear_Format
    With selected_Range
        .FormatConditions.Add Type:=xlTextString, String:=txA, _
            TextOperator:=xlContains
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = RGB(Rgb1, Rgb2, Rgb3)
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
    End With

End Sub

Sub clear_Format()
    Dim fc As FormatCondition
    For Each fc In ActiveSheet.Cells.FormatConditions
'        Debug.Print fc.Interior.Color
        If fc.Type = xlTextString Then
            If fc.Interior.Color = RGB(Rgb1, Rgb2, Rgb3) Then
                fc.Delete
                Exit For
            End If
        End If
    Next fc
End Sub

Sub to_label(a As Long)

With Me.Label1
If a = 1 Then
    .Caption = "Find What: "
    .ForeColor = vbBlack
Else
    .Caption = "Nothing found"
    .ForeColor = vbRed
    Beep
End If
End With

End Sub
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
With selected_Range
    
    Set c = .Find(What:=txA, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    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
    
End With

End Sub

Private Sub CommandButton2_Click()
'PREV BUTTON
If txA = "" Then Exit Sub
    
    Dim c As Range
    With selected_Range
        Set c = .Find(What:=txA, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
        If Not c Is Nothing Then
            c.Activate
            to_label (1)
        Else
            to_label (2)
        End If
    End With

End Sub

Private Sub CommandButton3_Click()
'NEXT BUTTON

If txA = "" Then Exit Sub
    
    Dim c As Range
    With selected_Range
        Set c = .Find(What:=txA, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Not c Is Nothing Then
            c.Activate
            to_label (1)
        Else
            to_label (2)
        End If
    End With

End Sub


Private Sub UserForm_Terminate()
If xCheck Then Call clear_Format
End Sub

 

[Jaafar Tribak]

Thanks @Akuini for sharing this nice utility. I like the idea of using CFormatting for higlighting.

Maybe sticking xRng.Select at the end of the FindAll commandbutton1 macro would be nice.

This search utility would also be great if made into an addin and callable from a button in the ribbon.

 

[Akuini]

Thanks @Akuini for sharing this nice utility. I like the idea of using CFormatting for higlighting.

Maybe sticking xRng.Select at the end of the FindAll commandbutton1 macro would be nice.

This search utility would also be great if made into an addin and callable from a button in the ribbon.

Thank you so much for reviewing my code.

I have decided to write a new version of this macro. In this updated version, I have replaced the Userform with an Inputbox. The reason behind this change is that it's more convenient to navigate through the highlighted cells using buttons in the sheet instead of the Userform. I will post the new version in a few minutes.

Regarding your suggestion to turn it into an add-in, I am interested, but I am not capable of creating an add-in that can create toolbar buttons to execute the macro. The add-in should ideally have four buttons in the toolbar: FIND, PREV, NEXT, and CLEAR BUTTON.

Any chances that you're interested in developing this into an add-in? I mean I'll be happy if you're willing to do that, and feel free to change the code anyway you want.