shinpencil
shinpencil

Reputation: 43

VBA- Ubound Lbound error

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

Answers (1)

Nigel Heffernan
Nigel Heffernan

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

Related Questions