excelvbaformat

Modify Text Colum while Preserving Its Format


I am trying to modify cells of a text column. In particular, I want to be able to remove a part of the text (XXX_) and strikethrough the part that succeeds it (YYYY). Moreover, I also want to preserve whatever format that other text in the cell might have.

Sample data

col1
"lorem ipso, XXX_YYYY, lorem ipso"

What I want is

col1
"lorem ipso, YYYY, lorem ipso"

BUT here's the catch:

  1. the lorem ipso could have arbitrary formatting (different size, color, bold, etc...): I want to be able to preserve its format - this is really crucial.
  2. I want to apply strikethrough to YYYY

I've tried this, but the main issue - and what I haven't figured out - is preserving the format of part of the text; the part that precedes XXX.

Here's what I've tried

Sub ModifyTextSingle()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim position As Integer
    Dim txt As String
    Dim rowNumber As Long
    Dim lengthYYYY As Integer
    Dim prefix As String
    
    ' Define worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' Get last row of data
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' Loop through each row in column A
    For rowNumber = 1 To lastRow
        Set cell = ws.Cells(rowNumber, 1) ' Adjust the column if needed
        
        ' Get the text from the cell
        txt = cell.Value
        
        ' Find the position of "XXX_"
        position = InStr(txt, "XXX_")
        lengthYYYY = Len("YYYY") ' Length of "YYYY"

        If position > 0 Then
            ' Store any text before "XXX_" ( BUT doesn't save the format)
            prefix = Left(txt, position - 1)
            
            ' Remove "XXX_" but keep the rest (and prepend any text before "XXX_")
            cell.Value = prefix & Mid(txt, position + Len("XXX_"))
            
            ' Find the new position of "YYYY" after "XXX_" is removed
            position = InStr(cell.Value, "YYYY")
            
            If position > 0 Then
                ' Apply strikethrough only to "YYYY"
                cell.Characters(position, lengthYYYY).Font.Strikethrough = True
            End If
        End If
    Next rowNumber
End Sub

Help would be immensely appreciated.


Solution

  • I think it doesn't have to be that complicated. The Characters.Delete method will perform this task.

    Sub ModifyTextSingle()
        Dim ws As Worksheet
        Dim lastRow As Long
        Dim cell As Range
        Dim position As Integer
        Dim txt As String
        Dim rowNumber As Long
        Dim lengthYYYY As Integer
        
        ' Define worksheet
        Set ws = ThisWorkbook.Sheets(1)  '"Sheet1"
        
        ' Get last row of data
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        
        ' Loop through each row in column A
        For rowNumber = 1 To lastRow
            Set cell = ws.Cells(rowNumber, 1) ' Adjust the column if needed
            
            ' Get the text from the cell
            txt = cell.Value
            
            ' Find the position of "XXX_"
            position = InStr(txt, "XXX_")
            lengthYYYY = Len("YYYY") ' Length of "YYYY"
    
            If position > 0 Then
               ' Remove "XXX_" but keep the rest (and prepend any text before "XXX_")
                cell.Characters(position, Len("XXX_")).Delete
                
                ' Find the new position of "YYYY" after "XXX_" is removed
                position = InStr(cell.Value, "YYYY")
                
                If position > 0 Then
                    ' Apply strikethrough only to "YYYY"
                    cell.Characters(position, lengthYYYY).Font.Strikethrough = True
                End If
            End If
        Next rowNumber
    End Sub
    

    Column A = After, Column F = Before
    Characters