Hi dulitu19,

Post back re how this goes:

Option Explicit
Sub Macro1()

    'Written by Trebor76
    'Visit my website www.excelguru.net.au

    Dim clnUniqueValues As New Collection
    Dim rngMyData As Range
    Dim rngCell As Range
    
    Set rngMyData = Range("B5:E30")
    
    Application.ScreenUpdating = False
    
    For Each rngCell In rngMyData
        If Evaluate("COUNTIF(" & rngMyData.Address & "," & rngCell.Address & ")") > 1 Then
            On Error Resume Next
                clnUniqueValues.Add rngCell.Value, CStr(rngCell.Value)
                If Err.Number = 0 Then 'First entry from a block of entries
                    rngCell.Interior.Color = RGB(255, 0, 0)
                Else
                    rngCell.Font.Bold = True
                End If
                Err.Clear
            On Error GoTo 0
        End If
    Next rngCell
    
    Set rngMyData = Nothing
    Set rngCell = Nothing
    Set clnUniqueValues = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Process is now complete"

End Sub
Regards,

Robert