change first 3 characters to bold format

user_14955503 0
Viewed 641

How do I change the first 3 characters and "CLEARANCE" Font to BOLD of cells containing "T##-" and loop it until the last row of STANDARD and NON-STANDARD tables

Sub Formatting()

    Dim StartCell As Range
    Set StartCell = Range("A15")
    Dim myList As Range

    Set myList = Range("A15:A" & Range("A" & Rows.Count).End(xlUp).Row)
    Dim x As Range

    For Each x In myList
        'myList.ClearFormats
        x.Font.Bold = False
        If InStr(1, x.Text, "CLEARANCE") > 0 Or InStr(1, x.Text, "clearance") > 0 Then
            x.Font.Bold = True
        Else
            x.Font.Bold = False
        End If
    Next
    
        For Each x In myList
        'myList.ClearFormats
        x.Font.Bold = False
        If InStr(1, x.Text, "T*") > 0 Then
            x.Font.Bold = True
        Else
            x.Font.Bold = False
        End If
    Next

End Sub

ORIG enter image description here

FORMATTED enter image description here

fonts vba excel loops
3 Answers

Here is one way to achieve what you want which I feel is faster (I could be wrong). This way lets Excel do all the dirty work :D.

Let's say our data looks like this

enter image description here

LOGIC:

  1. Identify the worksheet you are going to work with.
  2. Remove any autofilter and find last row in column A.
  3. Construct your range.
  4. Filter the range based on "=T??-*" and "=*CLEARANCE*".
  5. Identify the filtered range.
  6. Check if there was anything filtered and if it was, then do a Find and Replace
  7. Search for "CLEARANCE" and replace with bold tags around it as shown in the code.
  8. Loop through the filtered range to create an html string and then copy to clipboard
  9. Finally paste them back.

CODE:

Is this what you are trying? I have commented the code so you should not have a problem understanding it but if you do them simply ask :)

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long
    Dim rng As Range, rngFinal As Range, aCell As Range
    Dim htmlString As Variant
    
    '~~> Set this to the relevant Sheet
    Set ws = Sheet1
    
    With ws
        '~~> Remove any autofilter
        .AutoFilterMode = False
        
        '~~> Find last row in Col A
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        
        '~~> Construct your range
        Set rng = .Range("A1:A" & lRow)
        
        '~~> Filter the range
        With rng
            .AutoFilter Field:=1, Criteria1:="=T??-*", _
                        Operator:=xlAnd, Criteria2:="=*CLEARANCE*"
                 
            '~~> Set the filtered range
            Set rngFinal = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With
    End With
    
    '~~> Check if there was anything filtered
    If Not rngFinal Is Nothing Then
        rngFinal.Replace What:="CLEARANCE", Replacement:="<b>CLEARANCE</b>", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
        False, ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
        
        '~~> Loop through the filtered range and add
        '~~> ending html tags and copy to clipboard and finally paste them
        For Each aCell In rng.SpecialCells(xlCellTypeVisible)
            If aCell Like "T??-*" Then
                htmlString = "<html><b>" & _
                             Left(aCell.Value2, 4) & "</b>" & _
                             Mid(aCell.Value2, 5) & "</html>"
                
                With CreateObject("htmlfile")
                    With .parentWindow.clipboardData
                        Select Case True
                            Case Len(htmlString): .setData "text", htmlString
                            Case Else: .GetData ("text")
                        End Select
                    End With
                End With
                
                DoEvents
                
                aCell.PasteSpecial xlPasteAll
            End If
        Next aCell
    End If
    
    '~~> Remove any filters
    ws.AutoFilterMode = False
End Sub

OUTPUT:

enter image description here

NOTE: If you want to bold either of the text when one of them is absent then change Operator:=xlAnd to Operator:=xlOr in the above code.

user_11405790

I thought I'd chuck in this solution based on regex. I was fiddling around a long time trying to use the Submatches attributes, but since they do not have the FirstIndex() and Lenght() properties, I had no other option than just using regular matching objects and the Like() operator:

Sub Test()

Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim rng As Range, cl As Range, lr As Long

lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Set rng = ws.Range("A1:A" & lr)

With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "\bCLEARANCE\b"
    For Each cl In rng
        If cl.Value Like "T[0-9][0-9]-*" Then
            cl.Characters(0, 3).Font.Bold = True
            If .Test(cl.Value) Then
                Set M = .Execute(cl.Value)
                cl.Characters(M(0).firstindex + 1, M(0).Length).Font.Bold = True
            End If
        End If
    Next
End With

End Sub

The Like() operator is there just to verify that a cell's value starts with a capital "T", two digits followed by an hyphen. This syntax is close to what regular expressions looks like but this can be done without a call to the regex-object.

When the starting conditions are met, I used a regex-match to test for the optional "CLEARANCE" in between word-boundaries to assert the substring is not part of a larger substring. I then used the FirstIndex() and Lenght() properties to bold the appropriate characters.

enter image description here

user_97581940

The short and easy, but not fast and flexible approach. "Bare minimum"
No sheet specified, so uses active sheet. Will ignore multiple instances of "CLEARANCE", will loop everything (slow), ingores starting pattern (only cares if it starts with "T"), doesn't remove any bold text from things that shouldn't be bold.

Sub FormattingLoop()
Dim x As Range
For Each x In Range("A15:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    If Left(x, 1) = "T" Then x.Characters(, 3).Font.FontStyle = "Bold"
    If InStr(UCase(x), "CLEARANCE") > 0 Then x.Characters(InStr(UCase(x), "CLEARANCE"), 9).Font.FontStyle = "Bold"
Next x
End Sub
user_71311220
Related