How can I combine these two strings using VBA while keeping the fonts and colors the same?-CodePudding

I'm trying to keep the characteristics of the two texts the same. All I want to do is take the text from column A, row 1 and make sure it's repeated in column B, row 1. If it is, I don't have to do anything. If it isn't, then all I would need to do is take the text from first first box, strike it through, make it red, and add it to the text in box 2.

How would I be able to do that? I tried assigning the text as a string to a variable, but when I try to combine it, the all the colors turn to black. Is there any simple approach to this?

Inputs Desired Output

I'm fairly new to VBA and any help would be greatly appreciated!

As for my code, this is what I have so far, but I think I'll have to completely rewrite it.

       x = Cells(i, 1) & "" & " "
    w = Cells(i, 2)
    If InStr(LCase(Cells(i, 2)), LCase(x)) = 0 Then
        full = x & "" & w
        Cells(i, 2) = full
    End If
    For lcounter = 1 To Len(Cells(i, 1))
        If Cells(i, 1).Characters(lcounter, 1).Text = Cells(i, 2).Characters(lcounter, 1).Text And Cells(i, 2).Characters(lcounter, 1).Font.ColorIndex = 3 Then
            Cells(i, 2).Characters(lcounter, 1).Font.Strikethrough = True
            Cells(i, 2).Characters(lcounter, 1).Font.ColorIndex = 3
        End If
    Next lcounter

This code only works if all of the text in cell 2 is red before merging. For some reason, if that's the case, the combined text is also red. But otherwise, for the example in the picture, this code doesn't work.

CodePudding user response：

Format Characters

Sub FormatCharacters()

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim rg As Range: Set rg = ws.Range("A1:B1")

    Dim Cell1 As Range: Set Cell1 = rg.Cells(1)
    Dim Cell2 As Range: Set Cell2 = rg.Cells(2)
        
    If Cell1.Value <> Cell2.Value Then
                
        ' Write the formats of the 2nd cell to an array.
        
        Dim Len1 As Long: Len1 = Len(Cell1)
        Dim Len2 As Long: Len2 = Len(Cell2)
    
        Dim LB As Long: LB = Len1   2
        Dim UB As Long: UB = LB   Len2 - 1
        
        Dim arr2() As Variant: ReDim arr2(LB To UB, 1 To 2)
        Dim j As Long: j = LB
        
        Dim i As Long
                
        For i = 1 To Len2
            With Cell2.Characters(i, 1).Font
                arr2(j, 1) = .Color
                arr2(j, 2) = .Strikethrough
                j = j   1
            End With
        Next i
    
        ' Concatenate the strings.
        
        Cell2.Value = Cell1.Value & " " & Cell2.Value
        
        ' Format the 1st cell's string.
        
        With Cell2.Characters(1, Len1).Font
            .Color = vbRed
            .Strikethrough = True
        End With
        
        ' Format the 2nd cell's string.
        
        For j = LB To UB
            With Cell2.Characters(j, 1).Font
                .Color = arr2(j, 1)
                .Strikethrough = arr2(j, 2)
            End With
        Next j
                
    End If
            
End Sub