Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub FindAndBold()
- Dim sFind As String
- Dim rCell As Range
- Dim rng As Range
- Dim lCount As Long
- Dim iLen As Integer
- Dim iFind As Integer
- Dim iStart As Integer
- On Error Resume Next
- Set rng = ActiveSheet.UsedRange. _
- SpecialCells(xlCellTypeConstants, xlTextValues)
- On Error GoTo ErrHandler
- If rng Is Nothing Then
- MsgBox "There are no cells with text"
- GoTo ExitHandler
- End If
- sFind = InputBox( _
- Prompt:="What do you want to BOLD?", _
- Title:="Text to Bold")
- If sFind = "" Then
- MsgBox "No text was listed"
- GoTo ExitHandler
- End If
- iLen = Len(sFind)
- lCount = 0
- For Each rCell In Selection
- With rCell
- iFind = InStr(.Value, sFind)
- Do While iFind > 0
- .Characters(iFind, iLen).Font.Bold = True
- lCount = lCount + 1
- iStart = iFind + iLen
- iFind = InStr(iStart, .Value, sFind)
- Loop
- End With
- Next
- If lCount = 0 Then
- MsgBox "There were no occurrences of" & _
- vbCrLf & "' " & sFind & " '" & _
- vbCrLf & "to bold."
- ElseIf lCount = 1 Then
- MsgBox "One occurrence of" & _
- vbCrLf & "' " & sFind & " '" & _
- vbCrLf & "was made bold."
- Else
- MsgBox lCount & " occurrences of" & _
- vbCrLf & "' " & sFind & " '" & _
- vbCrLf & "were made bold."
- End If
- ExitHandler:
- Set rCell = Nothing
- Set rng = Nothing
- Exit Sub
- ErrHandler:
- MsgBox Err.Description
- Resume ExitHandler
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement