I have an array that is stored in a dictionary that it limits from (0 to 29 and 0 to 7) and stores a mixture of strings and integers.
I try to get one column from it without loops, but every time I get a type mismatch error.
I saw that there is a limit on the size of the array that can be used with application.index, but it is not so close to this limit.
Dim tmp As Variant
' Get Array from Public Dictionary
tmp = FBList(214)
' Output a string of values from one column of array
Debug.Print Join(Application.WorksheetFunction.Index(tmp, 19, 0), ",")
I always get type mismatch on the last line. I have successfully used this with other arrays, but not this time.
Sample file
Update: FBList Fill
Dim i As Integer, j As Integer, NoCol As Integer, si As Integer, sKey As Integer
Set cn = Nothing
With FBList
.RemoveAll
.CompareMode = TextCompare
End With
With FBMap
.RemoveAll
.CompareMode = TextCompare
End With
If UserList.Count = 0 Or ThisUser = "" Then Call UserDL
Call ConnecttoDB
Set cmd = New ADODB.Command: Set rs = New ADODB.Recordset
With cmd
.CommandTimeout = 120
.ActiveConnection = cn
.CommandText = "CSLL.Reports"
.CommandType = adCmdStoredProc
.Parameters.refresh
.Parameters("@Alias").value = ThisUser
On Error GoTo NoConnection
Set rs = .Execute
On Error GoTo 0
End With
With rs
For i = 0 To .Fields.Count - 1
If i = 0 Then
FBMap.Add .Fields.Item(0).Name, "Key"
Else
FBMap.Add .Fields.Item(i).Name, i - 1
End If
Next i
NoCol = .Fields.Count - 2
If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst
While (Not .EOF)
With FBList
ReDim UStemp(0 To NoCol, 0) As Variant
sKey = rs("ID")
If Not .Exists(sKey) Then
For i = 1 To NoCol + 1
UStemp(i - 1, 0) = rs(i)
Next i
.Add sKey, UStemp
ElseIf .Exists(sKey) = True Then
si = UBound(FBList(sKey), 2)
ReDim UStemp(0 To NoCol, 0 To si + 1)
For j = 0 To si + 1
If j <= si Then
For i = 0 To NoCol
UStemp(i, j) = .Item(sKey)(i, j)
Next i
ElseIf j > si Then
For i = 0 To NoCol
UStemp(i, j) = rs(i + 1)
Next i
End If
Next j
.Remove sKey
.Add sKey, UStemp
End If
End With
.MoveNext
Wend
.MoveFirst
End If
End With
Set cmd = Nothing: Set rs = Nothing: Set cn = Nothing
-------- @Vityata Please look at this:
Option Explicit
Public Sub ProofOfSlicingWithArray()
Dim tmp(1 To 10, 1 To 10) As Variant
Dim i As Long, j As Long
' Populate multi-dimensional array
For i = 1 To 10
For j = 1 To 10
tmp(i, j) = Int((999 - 100 + 1) * Rnd + 100)
Next j
Next i
Debug.Print Join(Application.Index(tmp, 5, 0), ",")
End Sub