CODEWITHSUNDEEP
excelvba
lyst
lyst

Reputation: 381

Detect difference between cells where text is the same but text formatting differs

I want to detect if anything about the text is different between two cells.

For example, cells A1 and B1 have the same text but different formatting of the text:

Cell A1: This is my cell.

Cell B1: This is my cell.

The following code does not flag a difference:

'if the text in the cells is different in any way, report a difference
If (ActiveSheet.Cells(1, "A") <> ActiveSheet.Cells(1, "B")) Then
    ActiveSheet.Cells(1, "C").Value = DIFFERENT
End If

Upvotes: 1

Views: 605

Answers (2)

user4039065
user4039065

Reputation:

I'm not sure whether comparing the cells' .Value(11) XML code will catch every discrepancy you are looking for but it does catch the differences in your example strings' formatting.

With ActiveSheet
    Debug.Print .Cells(1, "A").Value(11)
    Debug.Print .Cells(1, "B").Value(11)
    If .Cells(1, "A").Value(11) <> .Cells(1, "B").Value(11) Then
      .Cells(1, "C").Value = "DIFFERENT"
    End If
End With

For the unformated cell this element is pretty plain.

...
<Cell><Data ss:Type="String">abcdef</Data></Cell>
...

Not so for the one formatted with bold and strike-through characters.

...
<Cell><ss:Data ss:Type="String" xmlns="http://www.w3.org/TR/REC-html40"><Font
   html:Color="#000000">ab</Font><B><S><Font html:Size="8.8000000000000007"
     html:Color="#000000">cde</Font></S></B><Font html:Color="#000000">f</Font></ss:Data></Cell>
...

To compare only that <Cell> element,

Dim val11A As String, val11B As String

With ActiveSheet
    val11A = Split(Split(.Cells(1, "A").Value(11), "<Cell>")(1), "</Cell>")(0)
    val11B = Split(Split(.Cells(1, "B").Value(11), "<Cell>")(1), "</Cell>")(0)
    If val11A <> val11B Then
      .Cells(1, "C").Value = "DIFFERENT"
    End If
End With

Upvotes: 1

Tim Williams
Tim Williams

Reputation: 166341

e.g:

Sub Tester()
    Debug.Print SameText(Range("B4"), Range("C4"))
End Sub

'call from VBA or as UDF
Function SameText(rng1 As Range, rng2 As Range) As Boolean
    Dim rv As Boolean, c1, c2, x As Long, arr, v

    If rng1.Value = rng2.Value Then
        rv = True
        arr = Array("Underline", "Fontstyle", "Color") '<< for example
        For x = 1 To Len(rng1.Value)
            Set c1 = rng1.Characters(x, 1).Font
            Set c2 = rng2.Characters(x, 1).Font
            For Each v In arr
                If CallByName(c1, v, VbGet) <> CallByName(c2, v, VbGet) Then
                    Debug.Print "Mismatch on " & v & " at position " & x, _
                                 rng1.Address, rng2.Address
                    rv = False
                    Exit Function
                End If
            Next
        Next x
    Else
        rv = False
    End If

    SameText = rv
End Function

Upvotes: 3

Related Questions