Macro with an exception

[Shaba]

I use this macro to change every "&" on the to bold is there a way to skip certain phrases containing an "&"?

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 rng
        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

 

[mmhill]

Your code with a couple ideas to skip stuff.

First idea - put phrases you want to skip into a string and see if the cell content is in the string. Look at lines 11, 12 and 13. I put skip phrases in a range and used Join(Application.Transpose(Range("\SKIPS")), "|") to make one long string. e.g., "Sam|Ed|Peter|Paul|Mary|Sally" then line 13 says if we dont find rCell value in this, go Bold Stuff.

Next idea - use an array and a LIKE comparison with wild cards. Lines 21,22, 23-27.

Sub FindAndBold()
Dim sFind$, rCell As Range, rng As Range, lCount&, iLen%, iFind%, iStart%

    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

    sFind = InputBox("What do you want to BOLD?", "Text to Bold")
    If sFind = "" Then MsgBox "No text was listed": GoTo ExitHandler

    iLen = Len(sFind)
    lCount = 0
    
11    Dim strSkipValues$
12    strSkipValues = Join(Application.Transpose(Range("\SKIPS")), "|") 'named a range \SKIPS and put stuff to skip in it
    
21    Dim ayLikeMatch, booGoBold As Boolean
22    ayLikeMatch = Array("State", "City", "South") 'rCells containing these works will be skipped
    
    For Each rCell In rng '<<<<< THIS LOOP ONLY HAS TEH SKIP TEST.  BOLD STUFF IS BELOW

13        If InStr(1, strSkipValues, rCell, vbBinaryCompare) = 0 Then GoSub BoldStuff
        
23        For Each element In ayLikeMatch
24            booGoBold = True: Debug.Print rCell
25            If rCell Like "*" & element & "*" Then booGoBold = False: Exit For ' You coud do this the other way e.g., if element like "*" & rCell & "*"
26        Next element
27        If booGoBold Then GoSub BoldStuff
      
    Next rCell
    
    Select Case lCount ' RATHER THAN A BUCH OF CONVOLUTED IF .. ELSEIF STATEMENTS, A SELECT CASE CAN BE EASIER
        Case 0
            MsgBox "There were no occurrences of" & vbCrLf & "' " & sFind & " '" & vbCrLf & "to bold."
        Case 1
            MsgBox "One occurrence of" & vbCrLf & "' " & sFind & " '" & vbCrLf & "was made bold."
        Case Else
            MsgBox lCount & " occurrences of" & vbCrLf & "' " & sFind & " '" & vbCrLf & "were made bold."
    End Select
    
Exit Sub
BoldStuff:
    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
    Return
ExitHandler:
    Set rCell = Nothing
    Set rng = Nothing
Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

 

[Peter_SSs]

@Shaba

Welcome to the MrExcel board!
When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug. My signature block below has more details. I have added the tags for you this time.