Windows 10
Excel pro Plus 2019


I am getting a Run-Time: error 13 - Data Mismatch when running my code below with excel VBA editor highlighting the two rows
If arrData(i, 1) = arrData(i + 1, 1) And arrData(i, 2) = arrData(i + 1, 2) And _
    arrData(i, 9) = arrData(i + 1, 9) And arrData(i, 10) = arrData(i + 1, 10) Then
I wanted to achieve the fastest possible method using VBA as using a formula (which I explain further down) takes excel over 6
minutes to run on a spreadsheet with currently 91,000 rows and when live, this figure will only increase.

What is it I am running the Sub on.
On a worksheet called "DATA SORT" with a header row.
There is data in Columns A to J.

For the sake of this explination, a number of rows with matching data in specific columns are essentually a data set for one product.

The defining Columns where matching data will occur are Columns A, B, I2 and J.
The data in Columns C, D, E, F, and G, will not match and will vary.
This is why I am using columns A, B, I2 and J to make the matches.

What is it that I am trying to do.
Where the data (or value) in Columns A, B, I2 and J match with the next row down, look at the row after that, if it also matches then
continue until the next row does not match.

*In essence that is defining the a set or group of rows that relate to each other because of the matches in Columns A, B, I2 and J.

For that set or group of "matching" rows, look at the data or values in the rows of Column E.
*Column E value will always be a number, either a 1 or 2 or a mix of 1's and 2's.

If the data/values in all of the cells are all 1's then in column K, in the last row of the matching data set enter the text "YES"
If the data/values in all of the cells are all 2's then in column K, in the last row of the matching data set enter the text "NO"
If the data/values in all of the cells are a mix or 1's and 2' then in column K, in the last row of the matching data set enter the text "MAYBE"

Then look at the row that did not match with the one above it, and where the data (or value) in Columns A, B, I2 and J match with the next row down, look at the row after that, if it also matches then continue down until the next row does not match.

*This defines the next Data Set (product family) repeat the process described above.
Then move on to the next, and then the next all of the way down the work sheet.

I am mindful to not confuse my description but I was origianlly using a formula to do this which was entered by VBA and copied down column K
until the last used row.

This was fine when the number of rows was fairly small, say around 1000, maybe 2000, but now there are 91,000 and this will get bigger, when pasted in and copied down by VBA it takes over 6 minutes to run
and the pages of the work sheet go dim - not good really.

I include it here so you might be able to see what I am trying to replace but this VBA was my attempt to replace the formula below with something faster.
My thinking was that loading as much of the data, that my knowledge alllows me to, in to an array and doing the calculations in memory *should* speed
up quite a lot.

=IF(AND(A2=A3,B2=B3,I2=I3,J2=J2),"",TEXTJOIN("+",,CHOOSE({1,2},IF(COUNTIFS( E$2:E2,1,B$2:B2,B2),"YES",""),IF(COUNTIFS(E$2:E2,2,B$2:B2,B2),"NO",""),2)))

This is kind of a big ask but I have tried to explain what I am trying do and what I have done to get as best as I can.


I am extremely grateful for any assistance.


Sub SortAndWriteLettersClmK()
'Turn off application settings
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, startRow As Long
    Dim matchCountOne As Long, matchCountTwo As Long
    Dim arrData As Variant, results() As String
    
    Set ws = ThisWorkbook.Worksheets("DATA SORT")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    'Read data into an array for faster processing
    arrData = ws.Range("A2:J" & lastRow).value
    ReDim results(1 To UBound(arrData))
    
    'Initialize startRow
    startRow = 1
    
    For i = 1 To UBound(arrData) - 1
        If arrData(i, 1) = arrData(i + 1, 1) And arrData(i, 2) = arrData(i + 1, 2) And _
           arrData(i, 9) = arrData(i + 1, 9) And arrData(i, 10) = arrData(i + 1, 10) Then
            'Matching row found, increment counts based on value in column E (position 5 in array)
            If arrData(i, 5) = 1 Then
                matchCountOne = matchCountOne + 1
            ElseIf arrData(i, 5) = 2 Then
                matchCountTwo = matchCountTwo + 1
            End If
        Else
            'Non-matching or final match in a series - determine what to write in column K
            If matchCountOne > matchCountTwo Then
                FillResults results, startRow, i, "YES"
            ElseIf matchCountTwo > matchCountOne Then
                FillResults results, startRow, i, "NO"
            ElseIf matchCountOne = matchCountTwo And matchCountOne > 0 Then
                FillResults results, startRow, i, "MAYBE"
            End If
            'Reset counters and set new start row
            matchCountOne = 0
            matchCountTwo = 0
            startRow = i + 1
        End If
    Next i
    
    'Write results to Column K
    ws.Range("K2:K" & lastRow).value = Application.Transpose(results)
'Turn on application settings
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub


Sub FillResults(arr() As String, start As Long, endRow As Long, value As String)
    'Helper sub
    Dim i As Long
    For i = start To endRow
        arr(i) = value
    Next i
End Sub