Advertisement
linhnc3

MacroExcel

Jun 12th, 2015
257
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.63 KB | None | 0 0
  1. Sub FindAndBold()
  2. Dim sFind As String
  3. Dim rCell As Range
  4. Dim rng As Range
  5. Dim lCount As Long
  6. Dim iLen As Integer
  7. Dim iFind As Integer
  8. Dim iStart As Integer
  9.  
  10. On Error Resume Next
  11. Set rng = ActiveSheet.UsedRange. _
  12. SpecialCells(xlCellTypeConstants, xlTextValues)
  13. On Error GoTo ErrHandler
  14. If rng Is Nothing Then
  15. MsgBox "There are no cells with text"
  16. GoTo ExitHandler
  17. End If
  18.  
  19. sFind = InputBox( _
  20. Prompt:="What do you want to BOLD?", _
  21. Title:="Text to Bold")
  22. If sFind = "" Then
  23. MsgBox "No text was listed"
  24. GoTo ExitHandler
  25. End If
  26.  
  27. iLen = Len(sFind)
  28. lCount = 0
  29.  
  30. For Each rCell In Selection
  31. With rCell
  32. iFind = InStr(.Value, sFind)
  33. Do While iFind > 0
  34. .Characters(iFind, iLen).Font.Bold = True
  35. lCount = lCount + 1
  36. iStart = iFind + iLen
  37. iFind = InStr(iStart, .Value, sFind)
  38. Loop
  39. End With
  40. Next
  41.  
  42. If lCount = 0 Then
  43. MsgBox "There were no occurrences of" & _
  44. vbCrLf & "' " & sFind & " '" & _
  45. vbCrLf & "to bold."
  46. ElseIf lCount = 1 Then
  47. MsgBox "One occurrence of" & _
  48. vbCrLf & "' " & sFind & " '" & _
  49. vbCrLf & "was made bold."
  50. Else
  51. MsgBox lCount & " occurrences of" & _
  52. vbCrLf & "' " & sFind & " '" & _
  53. vbCrLf & "were made bold."
  54. End If
  55.  
  56. ExitHandler:
  57. Set rCell = Nothing
  58. Set rng = Nothing
  59. Exit Sub
  60.  
  61. ErrHandler:
  62. MsgBox Err.Description
  63. Resume ExitHandler
  64. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement