How do I take data from a cell in Excel and compare it character by character with another cell?-CodePudding

I am writing a program in Excel to compare PDF's when pasted into the file. I am trying to compare entries in cells of two worksheets and if there is a difference between any of the characters in the cells it should highlight that character red.

I tried to loop down the worksheet and store each cell as a string and then convert each into an Array one at a time. The program would then loop through each element of the arrays and compare them and highlight each of the characters red if there was a difference between them.


Sub Standard_Solver()

'Code gets the amount of rows to loop through
Dim rowsWithData1, rowsWithData, rowsToLoopTo As Integer
rowsWithData1 = Worksheets(1).UsedRange.rows.Count
rowsWithData2 = Worksheets(2).UsedRange.rows.Count

If rowsWithData1 < rowsWithData2 Then
    rowsToLoopTo = rowsWithData2
Else
    rowsToLoopTo = rowsWithData1
End If

'Loop to select each cell one by one and make their values a string
Dim cell1, cell2, cell3, outst As String, range1, range2 As Range, stringToArray1, stringToArray2 As Variant

For row = 1 To rowsToLoopTo
    Worksheets(1).Activate
    cell1 = Cells(row, 1).Value
    stringToArray1 = Array(cell1)
    Worksheets(2).Activate
    cell2 = Cells(row, 1).Value
    stringToArray2 = Array(cell2)
    
     'What to do if the whole cell isn't equal
    If cell1 <> cell2 Then
        Dim charn As Integer
        If Len(cell1) < Len(cell2) Then
            cell3 = Len(cell2)
        Else
            cell3 = Len(cell1)
        End If
        'Comparing each character of each string
        For charn = 0 To cell3
            'What to do if the two characters aren't equal
            'Issue is that it is coloring the whole cell not the characters
            If stringToArray1(charn) <> stringToArray2(charn) Then
                Worksheets(1).Activate
                Cells(row, 1).Characters(charn).Font.ColorIndex = 3
                Worksheets(2).Activate
                Cells(row, 1).Characters(charn).Font.ColorIndex = 3
            'What to do if the two characters are equal
            Else
            End If
        Next charn
            
    'If no differences do nothing and go to next row
    Else
    
    End If
    
Next row
    
End Sub

The problem is that upon running, it will color all of the characters in the first cell red and then have a runtime error. There may be a much simpler way to do this.

CodePudding user response：

This is what ended up working for anyone for future reference.

For j = 1 To rows Dim string1c, string2c As String, string1(), string2(), i, length As Integer Worksheets(1).Activate string1c = Cells(j, 1) Worksheets(2).Activate string2c = Cells(j, 1)

'Getting max length each array should be
If Len(string1c) > Len(string2c) Then
    length = Len(string1c)
Else
    length = Len(string2c)
End If

ReDim string1(1 To length)
ReDim string2(1 To length)

'Loop through each character in each string and store that in their respective arrays
For i = 1 To length
    string1(i) = Mid$(string1c, i, 1)
    string2(i) = Mid$(string2c, i, 1)

CodePudding user response：

Let me give you a piece of advise as far as performance is concerned: I have the impression that you are comparing two strings character per character and when you see a difference, you highlight it.

I would advise you first to check if both strings are different, and only in that case do the character-per-character check: when two strings are equal, it makes no sense to do that check and you might gain a lot of time like this.