Sub Five()
 Dim rngB As Range
 Dim rngZ As Range
 Dim Five As Long
 Dim varZ As Variant
 Dim intI As Integer
   For Each rngB In Selection.Areas
      For Each rngZ In rngB
         For intI = 1 To Len(rngZ.Value)
         varZ = Mid(rngZ.Value, intI, 1)
            If varZ = 5 Then
               Five = Five + 1
            End If
         Next intI
      Next rngZ
   Next rngB
 MsgBox Five
End Sub