How to change Spreadsheet search (find) results cell border colour ?

[gray_b]

How to change Spreadsheet search (find) results cell border colour ?

Seems so easy, but just cannot find anywhere that shows you.

Excel 365 currently shows dark green, but with my eyes and screen colours, it looks very similar to the black of the grid lines.

 

[Jaafar Tribak]

If you are referring to the found cells using the excel Find & Replace feature then the borders of the found cells will be the same as when manually selecting the cells.
I too get a dark green color for the cells borders whether by using the excel Find dialog or by simply manually selecting the cells. I use excel 2016. This is the default color and behaviour.
I don't think there is a built-in setting for changing the border of selected cells. I Checked the themes under the Page Layout tab but it doesn't seem to affect the borders of selected cells.

If you have difficulty seeing the found cells, you can use some vba code. However, changing the borders color/size of a selected cell won't make a difference as the applied frame by excel sits on top and will override whatever borders you have made. You can however temporarly change the selected cell color to highlight the cell.

If you are interested, here is an adaptation of some old code I wrote years ago that highlights the found cells when using the native excel Find & Replace dialog:

You can pass the highlight color of your choice in the argument of the HighlightFindAndReplaceCells routine.

Workbook Demo:
FindAndReplace_Highlight.xlsm







1- In a new Standard Module:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As Long
    Private Declare PtrSafe Function GetDlgItemText Lib "user32" Alias "GetDlgItemTextA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As Long
    Private Declare Function GetDlgItemText Lib "user32" Alias "GetDlgItemTextA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
    Private Declare Function GetFocus Lib "user32" () As LongPtr
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#End If

Private hwnd As LongPtr, lColor As Long
Private oFC As FormatCondition
Private bHighlighted As Boolean


Public Sub HighlightFindAndReplaceCells(Optional ByVal Color As Long = vbYellow)
    If IsFindDlg Then
        lColor = Color
        Call KillTimer(Application.hwnd, 0&)
        Call SetTimer(Application.hwnd, 0&, 0&, AddressOf MonitorProc)
    End If
End Sub


' _____________________________________________ PRIVATE ROUTINES _____________________________________
Private Sub StopHighlighting()
    bHighlighted = False
    Call KillTimer(Application.hwnd, 0&)
    Call HighlightFoundCell(ActiveCell, False)
    Set oFC = Nothing
    Debug.Print "done - timer released."
End Sub


Private Sub MonitorProc()
    Static oPrevRange As Range
    Dim sBuffer As String * 256&, lRet As Long

    If IsFindDlg = False Then
     Set oPrevRange = Nothing
        Call StopHighlighting
        Exit Sub
    End If

    If GetFocus = GetDlgItem(hwnd, &H12&) Then
        If Not oPrevRange Is Nothing Then
            If ActiveCell.Address <> oPrevRange.Address Then
                Call HighlightFoundCell(oPrevRange, False)
            End If
        End If
        lRet = GetDlgItemText(hwnd, &H12&, sBuffer, Len(sBuffer))
        If InStr(1&, ActiveCell, Left(sBuffer, lRet), vbTextCompare) Then
            If bHighlighted = False Then
                bHighlighted = True
                Call HighlightFoundCell(ActiveCell)
            End If
        End If
    End If

    If IsFindDlg Then
        Set oPrevRange = ActiveCell
    End If
End Sub

Private Sub HighlightFoundCell(ByVal Cell As Range, Optional ByVal bHighlight As Boolean = True)
    On Error Resume Next
    If bHighlight Then
        Set oFC = Cell.FormatConditions.Add(Type:=xlExpression, Formula1:="=TRUE")
        oFC.Interior.Color = lColor
        oFC.Priority = 1
    Else
        If Not oFC Is Nothing Then
            If oFC.Formula1 = "=TRUE" Then
                bHighlighted = False
                oFC.Delete
            End If
        End If
    End If
End Sub

Private Function IsFindDlg() As Boolean
    hwnd = FindWindow("bosa_sdm_XL9", "Find And Replace") '<== Dlg caption is language dependent.
    If hwnd Then IsFindDlg = True
End Function

Private Sub Auto_Close()
    Call StopHighlighting
End Sub

2- Usage;
In the ThisWorkbook Module:

Option Explicit

Private WithEvents cmbEvents As CommandBars

Private Sub Workbook_Activate()
    Set cmbEvents = Application.CommandBars
End Sub

Private Sub cmbEvents_OnUpdate()
    Call HighlightFindAndReplaceCells(Color:=vbYellow)
End Sub