Trovare valori uguali e restituire i nomi legati ad essi

 =SE(E$19="";0;CONTA.SE($E$21:$P$21;E$21)-1) 

Option Explicit

Sub Utili()
Application.ScreenUpdating = False
Dim x As Byte, y As Byte, NUt As Byte
Dim Utl As String

    Range(Cells(37, 5), Cells(37, 16)).ClearContents
    For x = 5 To 16
        If Cells(21, x) = 0 Then Cells(37, x) = 0
    Next x
        Cells(37, 5).Value = "X"
    For x = 5 To 15
        If Cells(37, x).Value = "" And Cells(21, x).Value <> "" Then Cells(37, x).Value = "X"
        If Cells(21, x) = "" Or Cells(37, x) <> 0 Then
            If Cells(37, x) <> "" And Cells(21, x) <> "" And Cells(38, x) <> 0 Then Utl = Utl & Cells(18, x).Value
        End If
            NUt = 0
            For y = 6 To 16
            If Cells(21, x) = Cells(21, y) And Cells(21, y) <> "" And Cells(37, y).Value = "" Then
                Utl = Utl & ", " & Cells(18, y)
                    Cells(37, x).Value = 0
                    Cells(37, y).Value = 0
                NUt = 1
            End If
            Next y
                If NUt = 1 Then Utl = Utl & " (" & Cells(21, x) & " €) - "
    Next x
        Utl = Left(Utl, Len(Utl) - 3)
        Cells(24, 20).Value = Utl
            Range(Cells(37, 5), Cells(37, 16)).ClearContents
Application.ScreenUpdating = True
    Cells(24, 20).Select
End Sub

Option Explicit

Sub Utili()
Application.ScreenUpdating = False
Dim x As Byte, y As Byte, NUt As Byte
Dim Utl As String

    If Application.WorksheetFunction.Max(Range("E19:P20")) = 0 Then
        MsgBox "Nessun utile." & Chr(10) & " La prossima volta, prima di premere il pulsante " _
        & Chr(34) & "Test" & Chr(34) & "," & Chr(10) & "controlla che ci sia almeno un Utile congruente."
        End
    End If

Option Explicit

Sub Utili()
Application.ScreenUpdating = False
On Error GoTo 10
.
.
.
            Range(Cells(37, 5), Cells(37, 16)).ClearContents
Application.ScreenUpdating = True
        End
10:
    Range(Cells(37, 5), Cells(37, 16)).ClearContents
        MsgBox "Non ci sono mesi con lo stesso Utile."
Application.ScreenUpdating = True
End Sub

Option Explicit

Sub Utili()
Application.ScreenUpdating = False
On Error GoTo 10
Dim x As Byte, y As Byte, NUt As Byte
Dim Utl As String

    If Application.WorksheetFunction.Max(Range("E19:P20")) = 0 Then
        MsgBox "Nessun utile." & Chr(10) & " La prossima volta, prima di premere il pulsante " _
        & Chr(34) & "Test" & Chr(34) & "," & Chr(10) & "controlla che ci sia almeno un Utile congruente."
        End
    End If
    
    Range(Cells(37, 5), Cells(37, 16)).ClearContents
    
    For x = 5 To 16
        If Cells(21, x) = 0 Then Cells(37, x) = 0
    Next x
    
        Cells(37, 5).Value = "X"
    For x = 5 To 15
        If Cells(37, x).Value = "" And Cells(21, x).Value <> "" Then Cells(37, x).Value = "X"
        If Cells(21, x) = "" Or Cells(37, x) <> 0 Then
            If Cells(37, x) <> "" And Cells(21, x) <> "" And Cells(38, x) <> 0 Then Utl = Utl & Cells(18, x).Value
        End If
            NUt = 0
            For y = 6 To 16
            If Cells(21, x) = Cells(21, y) And Cells(21, y) <> "" And Cells(37, y).Value = "" Then
                Utl = Utl & ", " & Cells(18, y)
                    Cells(37, x).Value = 0
                    Cells(37, y).Value = 0
                NUt = 1
            End If
            Next y
                If NUt = 1 Then Utl = Utl & " (" & Cells(21, x) & " €) - "
    Next x
        Utl = Left(Utl, Len(Utl) - 3)
        Cells(24, 20).Value = Utl
            Range(Cells(37, 5), Cells(37, 16)).ClearContents
Application.ScreenUpdating = True
    Cells(24, 20).Select
        End
10:
    Range(Cells(37, 5), Cells(37, 16)).ClearContents
        MsgBox "Non ci sono mesi con lo stesso Utile."
Application.ScreenUpdating = True
    Cells(24, 20).Select
End Sub

ActiveSheet.Unprotect Password:= tua password

ActiveSheet.Protect Password:= tua password

=SE(E(E$19="";E$20="");0;CONTA.SE($E$21:$P$21;E$21)-1)