Reputation: 43
I need help plz I wrote the code below, but it throw up error 13 type mismatch at the line "For i = LBound(header, 2) To UBound(header, 2)". Where is the problem?
Function Get_Header_Dico(ByVal header As Variant, _
ByVal header_line As Long) As Dictionary
Dim i As Long
Dim headerDict As Dictionary
Set headerDict = New Dictionary
For i = LBound(header, 2) To UBound(header, 2)
If Not headerDict.Exists(header(header_line, i)) Then
headerDict.Add header(header_line, i), i
Else
MsgBox "Please check data header, there is a duplicate"
End
End If
Next i
Set Get_Header_Dico = headerDict
End Function
I am trying to compare 2 workbooks. Here is the calling code:
Sub Find_Differences()
Dim wb1 As Workbook, wb2 As Workbook
Dim data1, data2
Dim header As Dictionary, data1_Dico As Dictionary, data2_Dico As Dictionary
Dim different_Dico As Dictionary
Dim key, tmp, result
Dim transaction_Type As String, ISIN As String, NAV_Date As String, value_Date As String, nature As String, amount As String
Dim i As Long, j As Long, lastRow As Long
Dim sBook As String
If Workbooks.Count < 2 Then
MsgBox "Erreur: Un seul fichier est ouvert" & vbCr & _
"Ouvrir un 2eme fichier et exécuter le macro"
Exit Sub
End If
Set wb1 = ThisWorkbook
For Each wb2 In Workbooks
If wb2.Name <> wb1.Name Then Exit For
Next
ReDo1:
Application.DisplayAlerts = False
sBook = Application.InputBox(prompt:= _
"Comparer ce fichier (" & wb1.Name & ") avec...?", _
Title:="Compare to what workbook?", _
Default:=wb2.Name, Type:=2)
If sBook = "False" Then Exit Sub
If Workbooks(sBook) Is Nothing Then
MsgBox "Fichier: " & sBook & " n'est pas ouvert."
GoTo ReDo1
Else
Set wb2 = Workbooks(sBook)
End If
Set header = Get_Header_Dico(data1, 1)
Set data1_Dico = New Dictionary
For i = 2 To UBound(data1, 1)
transaction_Type = data1(i, header("Transaction Type"))
ISIN = data1(i, header("ISIN Code"))
NAV_Date = Format(data1(i, header("NAV Date")), "dd/mm/yyyy")
value_Date = Format(data1(i, header("Value Date")), "dd/mm/yyyy")
nature = data1(i, header("Investment Type"))
If nature = "Unit" Then
amount = Format(data1(i, header("Share Nb.")), "#0.0000")
ElseIf nature = "Amount" Then
amount = Format(data1(i, header("Fund Amount (Client Cur.)")), "#0.0000")
End If
key = transaction_Type & "#" & ISIN & "#" & NAV_Date & "#" & value_Date & "#" & nature & "#" & amount
If Not data1_Dico.Exists(key) Then
data1_Dico.Add key, i
End If
Next i
Set header = Get_Header_Dico(data2, 1)
Set data2_Dico = New Dictionary
For i = 2 To UBound(data2, 1)
transaction_Type = data2(i, header("S/R type"))
ISIN = data2(i, header("Fund share code"))
NAV_Date = Format(data2(i, header("Pricing Date")), "dd/mm/yyyy")
value_Date = Format(data2(i, header("Value Date")), "dd/mm/yyyy")
nature = data2(i, header("Nature"))
If nature = "Unit" Then
amount = Format(data2(i, header("Quantity")), "#0.0000")
ElseIf nature = "Amount" Then
amount = Format(data2(i, header("Net amount")), "#0.0000")
End If
key = transaction_Type & "#" & ISIN & "#" & NAV_Date & "#" & value_Date & "#" & nature & "#" & amount
If Not data2_Dico.Exists(key) Then
data2_Dico.Add key, i
End If
Next i
Set different_Dico = New Dictionary
For Each key In data1_Dico.Keys
If Not data2_Dico.Exists(key) Then
different_Dico.Add key, key
End If
Next key
ReDim result(1 To different_Dico.Count, 0 To 5)
i = 0
For Each key In different_Dico.Keys
tmp = Split(key, "#")
i = i + 1
For j = 0 To UBound(tmp)
result(i, j) = tmp(j)
Next j
Next key
With ThisWorkbook.Sheets("Differences")
.Cells.Clear
.Range("A1").Resize(UBound(result, 1), UBound(result, 2) + 1) = result
End With
Set different_Dico = New Dictionary
For Each key In data2_Dico.Keys
If Not data1_Dico.Exists(key) Then
different_Dico.Add key, key
End If
Next key
ReDim result(1 To different_Dico.Count, 0 To 5)
i = 0
For Each key In different_Dico.Keys
tmp = Split(key, "#")
i = i + 1
For j = 0 To UBound(tmp)
result(i, j) = tmp(j)
Next j
Next key
With ThisWorkbook.Sheets("Differences")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A" & lastRow + 2).Resize(UBound(result, 1), UBound(result, 2) + 1) = result
End With
ThisWorkbook.Sheets("Differences").Activate
End Sub
Upvotes: 2
Views: 3645
Reputation: 4726
You're assuming that header
will be a variant array; this isn't always true and, as John Coleman pointed out, you would do well to check the type.
This is a common error, and the underlying cause is:
Passing an Excel Range object into a variant parameter in an Excel VBA function does not cast the incoming data to a variant data type.
Yes, we know that the expected behaviour of the 'cast' is that an object will populate a variant with it's default property, and the default property property of a range is the .Value
variant - but the result you actually get is that your 'variant' is an Excel Range.
So your variant header
contains a reference to an object.
Now there are some functions - UBound() and LBound() spring to mind - which expect to see an array and will automatically cast the range's default .Value
property as a variant array. But...
If you've passed in a single-cell range, the .Value
property of the range isn't an array.
... and, for a single-cell range, it's a scalar variant; the type is a string or number or datetime type inferred from the cell's .NumberFormat
property, and any functions which expect an array will throw a type error when they get that. Yes, UBound() and LBound() spring to mind, again: they'll work just fine, right up until the day you pass in a single-cell range.
Other things in a range will break 'downstream' functions that can cope with a simple grid of data from the spreadsheet: I'm guessing that you've got the most common example, a single cell; but an uninitialised Nothing
object variable of type Range might just get far enough into the code to raise a Type error, too: as will a non-contiguous range (an array of arrays, each item corresponding to the .value properties of the range's .Areas collection).
If we're lucky other 'Stackers will comment and list even more exotic examples; and quite possibly, mundane examples that I've never heard of and would otherwise discover when my own code halts exactly where yours did today.
So the answer to your question is to check the incoming parameter, almost exactly as John Coleman suggested, and then populate an internal variable with your data:
Dim arrData As Variant
'If TypeOf header IS Excel.Range Then ' replaced by 'TypeName', which is more robust
If TypeName(header) = "Range" Then
If header.Areas(1).Cells.Count = 1 Then
Redim arrData(1 To 1, 1 To 1)
arrData(1, 1) = header.Areas(1).Value2
Else
arrData = header.Areas(1).Value2
End If
Else
If Instr(TypeName(header),"(") > 1 Then 'This is more reliable than IsArray()
arrData = header
Else
Redim arrData(1 To 1, 1 To 1)
arrData(1, 1) = header
End If
End If
' ...And run arrData through your code, instead of 'header'
Almost exactly as John suggested: searching the 'TypeName' for brackets is a more robust way of detecting an array than using varType.
You would also be well advised to run IsError()
on the contents of any variant obtained from an Excel Range: once imported into VBA, formula errors in an range are intractable - no VBA function or operator can handle them.
And the moral of the story is:
Writing a function that takes data from the worksheet always involves more defensive coding than you expected.
Let us know how you get on!
Upvotes: 2