Option Explicit
Sub calcValues()
  Dim arr() As Variant
  Dim res() As Integer
  Dim s As String
    
  Dim i As Integer
  Dim j As Integer
  Dim iMax As Integer
  Dim sMax As String
  Dim iVal As Integer
  Dim iValCurr As Integer
  Dim k As Integer
  Dim p As Integer
  Dim n As Integer
  Dim m As Integer
  
  k = Cells(1, 4).Value
  iMax = 0
  arr = Range(Cells(2, 1), Cells(19, 1))
  n = UBound(arr, 1)
  ReDim res(1 To k)
  For i = 1 To k
    res(i) = i
  Next
  p = k
  Do While p >= 1
'//---
      iVal = 0
      For m = 1 To Len(arr(res(1), 1))
        iValCurr = 1
        For j = LBound(res) To UBound(res) - 1
          If StrComp(Mid(arr(res(j), 1), m, 1), Mid(arr(res(j + 1), 1), m, 1)) <> 0 Then
            iValCurr = 0
            Exit For
          End If
        Next j
        iVal = iVal + iValCurr
      Next m
      If iMax < iVal Then
        s = ""
        For j = LBound(res) To UBound(res)
          s = s & "," & CStr(res(j))
        Next j
        sMax = Right(s, Len(s) - 1)
        iMax = iVal
      End If
'//===
    If res(k) = n Then
       p = p - 1
    Else
       p = k
    End If
    If p >= 1 Then
     For i = k To p Step -1
         res(i) = res(p) + i - p + 1
     Next
    End If
  Loop
  
  sMax = "Строки " & sMax & " совпадений - " & iMax
  MsgBox sMax
End Sub

Sub ПростейшийПримерИспользованияПрогрессБара()
    Dim pi As New ProgressIndicator    ' создаём новый прогресс-бар
    pi.Show "Подождите, работает макрос"    ' отбражаем индикатор

    ' здесь код вашего макроса

    pi.Hide    ' закрываем индикатор
End Sub