Verifica con calma che non mi sia sfuggito qualcosa visto che te l'ho scritta di getto.
codice:
Option Base 0
Option Explicit
Sub seleziona()
On Error Resume Next
Dim i As Integer
Dim cella As Range
Dim limiti() As Variant
Dim selezione As Range
Dim identificatore As String
ActiveSheet.Cells.ClearFormats
i = 0
Set selezione = Application.InputBox(Prompt:="Seleziona intervallo", Title:="Mio range", Type:=8)
If (selezione Is Nothing) = False Then
identificatore = Application.InputBox(Prompt:="Inserisci delimitatoree", Title:="Identificatore", Type:=2)
For Each cella In selezione
If i <= 1 Then
If cella.Value = identificatore Then
ReDim Preserve limiti(0 To i)
limiti(i) = cella.Address
i = i + 1
End If
Else
Exit For
End If
Next cella
End If
ActiveSheet.Range(limiti(0) & ":" & limiti(1)).Interior.ColorIndex = 4
End Sub