ReDim Runtime Error 13- Mismatch

[bujubenji]

Hi all,

I've pieced together the below code from other forums to achieve something I thought would be relatively simple, but it has thrown up an error which I'm not capable of solving.

I have two ranges B44:E58 and H44:K58- products are listed starting at B44 with various details in the three columns to the right. When sent to quality assurance, I hit a button which copies the data into the range starting at H44. If I hit the button again (in the event of it being clicked accidentally, it removes said data from the range starting at H44 and originally deleted the consequently blank row and shifted up. I have a third range (M44:M58) which identifies outstanding products i.e. products which have not been sent to quality assurance.

The button which deleted blank rows meant that I couldn't use a filter function in M44 (FILTER(B44:B58,NOT(COUNTIF(H44:H58,B44:B58))) as the formula was being compromised due to deleted rows in the H range.

I resorted to the below code to get around this. I have since change the delete blank rows line of the code to sort meaning that I can now use the filter formula, however, it is bugging me that I couldn't get the below code to work.


Oddly, it works perfectly if there is more than 1 product in the B44:E58 range, but runs into a Runtime Error 13- Type Mismatch if there is only one row of data. Any ideas?


Dim rng As Range
Set rng = Range("M44:R58")
rng.ClearContents

Dim v1, v2, v3(), i As Long, j As Long

v1 = Range("B44", Range("B" & Rows.Count).End(xlUp)).Value
v2 = Range("H43", Range("H" & Rows.Count).End(xlUp)).Value

' THIS LINE IS THROWING UP THE ERROR RUNTIME ERROR 13- TYPE MISMATCH
ReDim v3(1 To UBound(v1, 1))

For i = LBound(v1) To UBound(v1)
If IsError(Application.Match(v1(i, 1), v2, 0)) Then
j = j + 1
v3(j) = v1(i, 1)
End If
Next i


On Error Resume Next
Range("M44").Resize(j) = Application.Transpose(v3)


thanks in advance

 

[DanteAmor]

You're right, the error is when you only have one record.

One option is always to add an extra row, but when reading the rows it will be for the total rows - 1:

Sub test()
  Dim v1, v2, v3(), i As Long, j As Long
 
  v1 = Range("B44", Range("B" & Rows.Count).End(xlUp)(2)).Value
  v2 = Range("H43", Range("H" & Rows.Count).End(xlUp)).Value
 
  ' THIS LINE IS THROWING UP THE ERROR RUNTIME ERROR 13- TYPE MISMATCH
  ReDim v3(1 To UBound(v1, 1) - 1)
 
  For i = LBound(v1) To UBound(v1) - 1
    If IsError(Application.Match(v1(i, 1), v2, 0)) Then
      j = j + 1
      v3(j) = v1(i, 1)
    End If
  Next i
  On Error Resume Next
  Range("M44").Resize(j) = Application.Transpose(v3)
End Sub

 

[bujubenji]

You're right, the error is when you only have one record.

One option is always to add an extra row, but when reading the rows it will be for the total rows - 1:

Sub test()
  Dim v1, v2, v3(), i As Long, j As Long
 
  v1 = Range("B44", Range("B" & Rows.Count).End(xlUp)(2)).Value
  v2 = Range("H43", Range("H" & Rows.Count).End(xlUp)).Value
 
  ' THIS LINE IS THROWING UP THE ERROR RUNTIME ERROR 13- TYPE MISMATCH
  ReDim v3(1 To UBound(v1, 1) - 1)
 
  For i = LBound(v1) To UBound(v1) - 1
    If IsError(Application.Match(v1(i, 1), v2, 0)) Then
      j = j + 1
      v3(j) = v1(i, 1)
    End If
  Next i
  On Error Resume Next
  Range("M44").Resize(j) = Application.Transpose(v3)
End Sub

Wizardry! Thanks so much Dante, works like a dream.