Highlight selected cells From search box

[berty2000]

Hi guys
Got a list of about 60 names (Range D4:D70) and put in a search box to search them.
Say searching for the name Dave it steps through about 6 different Daves, I would like it to highlight each Dave in Yellow and when I close the seach box they stay yellow, so they are easy to find as each is hyperlinked.

When I call up another name with the search it will change the yellow highlighted ones back.
This is my code so far:

Sheet1

Private Sub CommandButton1_Click()

'clear cells
Range("d4:d100").Interior.ColorIndex = 0

'open a find box
Application.Dialogs(xlDialogFormulaFind).Show

With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid

End With
End Sub


Any Clues as keep going round in circles.

 

[Domenic]

Maybe something like this...

[font=Verdana][color=darkblue]Private[/color] [color=darkblue]Sub[/color] CommandButton1_Click()

    [color=darkblue]Dim[/color] FoundCells [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] Cell [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] FirstAddress [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] SearchTerm [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    LastRow = Cells(Rows.Count, "D").End(xlUp).Row
    
    [color=darkblue]If[/color] LastRow >= 4 [color=darkblue]Then[/color]
    
        [color=darkblue]Set[/color] Rng = Range("D4:D" & LastRow)

        Rng.Interior.ColorIndex = 0
        
        SearchTerm = Application.InputBox("Please enter your search term...", "Search Term", Type:=2)
        
        [color=darkblue]If[/color] SearchTerm <> "False" [color=darkblue]Then[/color]
            [color=darkblue]With[/color] Rng
                [color=darkblue]Set[/color] Cell = .Find(what:=SearchTerm, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
                [color=darkblue]If[/color] [color=darkblue]Not[/color] Cell [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
                    FirstAddress = Cell.Address
                    [color=darkblue]Do[/color]
                        [color=darkblue]If[/color] FoundCells [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
                            [color=darkblue]Set[/color] FoundCells = Cell
                        [color=darkblue]Else[/color]
                            [color=darkblue]Set[/color] FoundCells = Union(FoundCells, Cell)
                        [color=darkblue]End[/color] [color=darkblue]If[/color]
                        [color=darkblue]Set[/color] Cell = .FindNext(Cell)
                    [color=darkblue]Loop[/color] [color=darkblue]While[/color] Cell.Address <> FirstAddress
                    [color=darkblue]With[/color] FoundCells.Interior
                        .ColorIndex = 6
                        .Pattern = xlSolid
                    [color=darkblue]End[/color] [color=darkblue]With[/color]
                [color=darkblue]Else[/color]
                    MsgBox "Search term not found...", vbExclamation
                [color=darkblue]End[/color] [color=darkblue]If[/color]
            [color=darkblue]End[/color] [color=darkblue]With[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        
    [color=darkblue]Else[/color]
    
        MsgBox "No data available...", vbExclamation
        
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

Note that for a partial match, replace...

xlWhole

with

xlPart

 

[berty2000]

That works excellent.
It does everything I need but is it possible for the screen to scroll down to the highlighted ones if they are off screen when the search happens ?

 

[Domenic]

Try making the following changes/additions in red. Note that I had previously forgotten to declare the object variable 'Rng'.

[font=Verdana][color=red]Option[/color] [color=red]Explicit[/color]

[color=darkblue]Private[/color] [color=darkblue]Sub[/color] CommandButton1_Click()

    [color=red]Dim[/color] [COLOR="Red"]Rng[/COLOR] [color=red]As[/color] [COLOR="Red"]Range[/COLOR]
    [color=darkblue]Dim[/color] FoundCells [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] Cell [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] FirstAddress [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] SearchTerm [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    LastRow = Cells(Rows.Count, "D").End(xlUp).Row
    
    [color=darkblue]If[/color] LastRow >= 4 [color=darkblue]Then[/color]
    
        [color=darkblue]Set[/color] Rng = Range("D4:D" & LastRow)

        Rng.Interior.ColorIndex = 0
        
        SearchTerm = Application.InputBox("Please enter your search term...", "Search Term", Type:=2)
        
        [color=darkblue]If[/color] SearchTerm <> "False" [color=darkblue]Then[/color]
            [color=darkblue]With[/color] Rng
                [COLOR="Red"][color=red]Set[/color] Cell = .Find(what:=SearchTerm, after:=Rng(Rng.Rows.Count), LookIn:=xlValues, _
                    lookat:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)[/COLOR]
                [color=darkblue]If[/color] [color=darkblue]Not[/color] Cell [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
                    FirstAddress = Cell.Address
                    [color=darkblue]Do[/color]
                        [color=darkblue]If[/color] FoundCells [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
                            [color=darkblue]Set[/color] FoundCells = Cell
                        [color=darkblue]Else[/color]
                            [color=darkblue]Set[/color] FoundCells = Union(FoundCells, Cell)
                        [color=darkblue]End[/color] [color=darkblue]If[/color]
                        [color=darkblue]Set[/color] Cell = .FindNext(Cell)
                    [color=darkblue]Loop[/color] [color=darkblue]While[/color] Cell.Address <> FirstAddress
                    [color=darkblue]With[/color] FoundCells.Interior
                        .ColorIndex = 6
                        .Pattern = xlSolid
                    [color=darkblue]End[/color] [color=darkblue]With[/color]
                    [COLOR="Red"]Application.Goto Range(FirstAddress), [color=red]True[/color][/COLOR]
                [color=darkblue]Else[/color]
                    MsgBox "Search term not found...", vbExclamation
                [color=darkblue]End[/color] [color=darkblue]If[/color]
            [color=darkblue]End[/color] [color=darkblue]With[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        
    [color=darkblue]Else[/color]
    
        MsgBox "No data available...", vbExclamation
        
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

 

[berty2000]

The screen scrolls down to show the highlighted cells, but it also scrolls to the right so you can't see the rows A, B, C is it possible to just scroll down without it moving over ?

 

[Domenic]

Try replacing...

 Application.Goto Range(FirstAddress), True

with

ActiveWindow.ScrollRow = Range(FirstAddress).Row

 

[berty2000]

Thats it complete thank you Domenic.

 

[Domenic]

You're welcome, and thanks for the feedback!