Convert range function to array function

[Dr. Demento]

I'm using the sub below to highlight differences between two strings. Normally, this works really well except when the datasets are large (+10K). Is there any way to convert this process to use arrays instead? The Range.Characters does the work but I wasn't sure if there's an array analog? Another related question is can the output of an array be format when it's written to a sheet (not after it's written)? That is, rather than making the font color/bold changes after the array is written, make the change in the array and have that directly transferred to the sheet (I think not but I'm so ignorant, it's hard to know what I don't know)

Alternatively, would it be faster to identify each non-matching character within the array, tag that character with a delimiter of some type (CHAR 166), and then do a Find/Replace of all of the delimiter (change font color/bold the single character after the delimiter and then delete the delimiter)??

Just looking to speed up the process.

My data uses "|" as a delimiter, as the data is concatenated. For example, the data looks like this:
20170101|USA|A|M|PDY||20170604
20170101|USA|A|M|PDY|99|20170611

A somewhat related question: how can I make it ignore the pipe-delimiter? The example above, the sub doesn't highlight the pipes, but with the example below, they are highlighted and I don't want them to be. I guess I could SPLIT the string and then re-JOIN it but that only works if the formatting can be applied within the array and not after. Thoughts??

20180101|USA|A|C|LEA||20180819
20180101|USA|A||LEA|1|20180819

Thanks y'all.

Public Sub str_deltas() 'gnrA As Range, _
                      gnrB As Range)
' ~~ Compare text and highlight difference
' https://stackoverflow.com/a/32300669 | https://stackoverflow.com/questions/32296937/compare-text-and-highlight-difference

Dim gnrA As Range, _
    gnrB As Range
  Set gnrA = [a1]
  Set gnrB = [b1]

Dim a$, b$
  a = gnrA.Value2
  b = gnrB.Value2
  
Dim i&, k&
  k = Len(a)
  If Len(b) > k Then _
    k = Len(b)

  Application.EnableEvents = False

  Do
    i = i + 1
    If Mid$(a, i, 1) <> Mid$(b, i, 1) Then
        Align i, a, b, gnrA, gnrB
    End If
    DoEvents
  Loop Until i > k
  
  k = Len(a): If Len(b) > k Then k = Len(b)
  
  For i = 1 To k
    If Mid$(a, i, 1) <> Mid$(b, i, 1) Then
      gnrA.Characters(i, 1).Font.Color = vbRed: gnrA.Characters(i, 1).Font.Bold = True
      gnrB.Characters(i, 1).Font.Color = vbRed: gnrB.Characters(i, 1).Font.Bold = True
    End If
'    If Mid$(b, i, 1) = "." Then gnrA.Characters(i, 1).Font.Color = vbRed
  Next i
  
  Do
    k = InStr(gnrA, "."): If k Then gnrA.Characters(k, 1).Delete
  Loop Until k = 0
  
  Do
    k = InStr(gnrB, "."): If k Then gnrB.Characters(k, 1).Delete
  Loop Until k = 0
  
End Sub
Private Sub Align(k&, a$, b$, rA As Range, rB As Range)

Dim i&, iMax&, nI&, nMaxI&, j&, jMax&, nJ&, nMaxJ&
  Const LOOK_AHEAD_BUFFER = 30
  
  For i = 0 To LOOK_AHEAD_BUFFER
    nI = CountMatches(Space$(i) & Mid$(a, k, LOOK_AHEAD_BUFFER), Mid$(b, k, LOOK_AHEAD_BUFFER))
    If nI > nMaxI Then
        nMaxI = nI: iMax = i
    End If
  Next i
  
  For j = 0 To LOOK_AHEAD_BUFFER
    nJ = CountMatches(Mid$(a, k, LOOK_AHEAD_BUFFER), Space$(j) & Mid$(b, k, LOOK_AHEAD_BUFFER))
    If nJ > nMaxJ Then
        nMaxJ = nJ: jMax = j
    End If
  Next j
  
  If nMaxI > nMaxJ Then
    a = Left$(a, k - 1) & String$(iMax, ".") & Mid$(a, k)
    rA = a: k = k + iMax
  Else
    b = Left$(b, k - 1) & String$(jMax, ".") & Mid$(b, k)
    rB = b: k = k + jMax
  End If
  
End Sub
Private Function CountMatches(a$, b$) As Long
Dim i&, k&, c&
  k = Len(a): If Len(b) < k Then k = Len(b)
  
  For i = 1 To k
      If Mid$(a, i, 1) = Mid$(b, i, 1) Then c = c + 1
  Next i
  
  CountMatches = c
  
End Function

 

[Dr. Demento]

Bump

Thoughts?