Replace special character

Sub wms()
  Dim wks           As Worksheet
  Dim cell          As Range
  Dim s             As String

  For Each wks In Worksheets
    For Each cell In Intersect(wks.Columns("B"), wks.UsedRange)
      s = cell.Value2
      Select Case LCase(Left(s, InStr(s, ".")))
        Case "mr.", "ms.", "mrs."
          cell.Offset(, 1).Value2 = Trim(Mid(s, InStr(s, ".") + 1))
        Case Else
          cell.Offset(, 1).Value2 = s
      End Select
    Next cell
  Next wks
End Sub