Runtime error: 13 mismatch in complicated VBA array
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
Code:
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.
Quote:
=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.
Code:
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
