I'm working on a small test file, and I'm having trouble storing an array object into a collection. I keep getting error 91.
Here's the code thus far:
Paste into a module
Paste into Class Module: "CCollection"
Starting in A1, enter the following values in each respective cells.
<tbody>
</tbody>
Let me explain how this test is supposed to work.
Column A represents the variable "depositDate" and column B represents the variable "saleDate."
In column D, negative numbers are completely ignored. In column E, these numbers are stored into a "special array" (arrSpecial). Everything else (column C:F, but not E) are stored into the regular array (arr). Zeros are to be ignored.
Each row represents a collection. However, if it just so happens that the deposit date and sales date are the same (see rows 1 & 2 and 4 & 5) then the macro should not be creating a new collection, and it should not be adding it to "Shortfalls" just yet; it should simply "append" the new data into the prior array.
I don't see any issues with the arrays, and it's not empty. Yet I get error 91. Any ideas why?
Here's the code thus far:
Paste into a module
Code:
Option Explicit
Option Base 1
Dim base As Integer
Sub CollectionsAndArrays()
Dim Shortfalls As New Collection
Dim shortfall As CCollection
Dim c As Range, thisRange As Range
Dim arr() As Variant, arrSpecial() As Variant
Dim i As Integer, j As Integer, k As Integer
Dim str As String
Dim depositDate As Range, saleDate As Range, depositDateNext As Range, saleDateNext As Range
Dim commit As Boolean
Dim arrSize As Integer, arrSpecialSize As Integer
base = 1
j = 1
k = 1
If Cells(1, 1) = Cells(2, 1) And Cells(2, 1) = Cells(2, 2) Then
commit = False
Else
commit = True
End If
For i = 1 To 7
Set thisRange = Range(Cells(i, 3), Cells(i, 6))
Set depositDate = Cells(i, 1)
Set saleDate = Cells(i, 2)
Set depositDateNext = Cells(i + 1, 1)
Set saleDateNext = Cells(i + 1, 2)
If depositDate <> depositDateNext And commit = True Then
Set shortfall = New CCollection
arrSize = ExcludeExceptionCount(thisRange)
arrSpecialSize = WorksheetFunction.Count(IntersectRange(Cells(i, 1), Range("E:E")))
ElseIf depositDate <> depositDateNext And commit = False Then
arrSize = arrSize + ExcludeExceptionCount(thisRange)
arrSpecialSize = arrSpecialSize + WorksheetFunction.Count(IntersectRange(Cells(i, 1), Range("E:E")))
commit = True
ElseIf saleDate <> saleDateNext And commit = True Then
Set shortfall = New CCollection
arrSize = ExcludeExceptionCount(thisRange)
arrSpecialSize = WorksheetFunction.Count(IntersectRange(Cells(i, 1), Range("E:E")))
ElseIf saleDate <> saleDateNext And commit = False Then
arrSize = arrSize + ExcludeExceptionCount(thisRange)
arrSpecialSize = arrSpecialSize + WorksheetFunction.Count(IntersectRange(Cells(i, 1), Range("E:E")))
commit = True
Else 'if all are equal
arrSize = arrSize + ExcludeExceptionCount(thisRange)
arrSpecialSize = arrSpecialSize + WorksheetFunction.Count(IntersectRange(Cells(i, 1), Range("E:E")))
commit = False
End If
On Error Resume Next
ReDim Preserve arr(arrSize)
If arrSize < base Then
ReDim Preserve arr(base)
End If
On Error GoTo 0
On Error Resume Next
ReDim Preserve arrSpecial(arrSpecialSize)
If arrSpecialSize < base Then
ReDim Preserve arrSpecial(base)
End If
On Error GoTo 0
' Store regular numbers into array
For Each c In thisRange
c.Select
If c <> 0 Then
If c.Column <> Range("E:E").Column Then
If c.Column <> Range("D:D").Column Then
arr(j) = c.Value
j = j + 1
ElseIf c > 0 Then
arr(j) = c.Value
j = j + 1
End If
End If
End If
Next c
Debug.Print "Orindary: " & StringConstructor(arr)
' store special numbers into special array
For Each c In thisRange
c.Select
If c.Column = Range("E:E").Column And c <> 0 Then
arrSpecial(k) = c.Value
k = k + 1
End If
Next c
Debug.Print "Special: " & StringConstructor(arrSpecial)
'////////////////////////////////////////////////////////////////////////
If commit = True Then
str = StringConstructor(arr)
Debug.Print "Committed_Ordinary: " & str
str = StringConstructor(arrSpecial)
Debug.Print "Committed Special: " & str
shortfall.Amount = arr
shortfall.AmountSpecial = arrSpecial
Shortfalls.Add shortfall
Erase arr, arrSpecial
j = 1
k = 1
End If
Next i
'//////////////////////////////////////////////////////////////////////////
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' Populate ordinary numbers
Range("H1").Select
For Each shortfall In Shortfalls
str = StringConstructor(shortfall.Amount)
If str <> vbNullString Then
ActiveCell.Formula = "=" & str
End If
' Populate special numbers
ActiveCell.Offset(, 1).Select
str = StringConstructor(shortfall.AmountSpecial)
If str <> vbNullString Then
ActiveCell.Formula = "=" & str
End If
ActiveCell.Offset(1, -1).Select
Next shortfall
End Sub
Function ExcludeExceptionCount(ByRef iRange As Range) As Integer
Dim c As Range
Dim i As Integer
For Each c In iRange
If c.Column = Range("D:D").Column And c < 0 Then
i = i + 1
End If
If c.Column = Range("E:E").Column And c <> 0 Then
i = i + 1
End If
Next c
ExcludeExceptionCount = WorksheetFunction.Count(iRange) - i
End Function
Function IntersectRange(ByRef RowRange As Range, ByRef ColRange As Range) As Range
Set IntersectRange = Application.Intersect(RowRange.EntireRow, ColRange.EntireColumn)
End Function
Function StringConstructor(ByRef iArray As Variant, Optional ByVal str As String) As String
Dim i As Integer
For i = LBound(iArray) To UBound(iArray)
If str = vbNullString Then
str = iArray(i)
Else
str = str & "+" & iArray(i)
End If
Next i
StringConstructor = str
End FunctionPaste into Class Module: "CCollection"
Code:
Private pAmount() As Variant
Private pAmountSpecial() As Variant
Public Property Get Amount() As Variant
Amount = pAmount
End Property
Public Property Let Amount(Value As Variant)
pAmount = Value
End Property
Public Property Get AmountSpecial() As Variant
AmountSpecial = pAmountSpecial
End Property
Public Property Let AmountSpecial(Value As Variant)
pAmountSpecial = Value
End PropertyStarting in A1, enter the following values in each respective cells.
| 1 | 1 | 12 | -10 | 123 | 10 |
| 1 | 1 | 53 | 75 | 22 | |
| 2 | 3 | 26 | 33 | 23 | |
| 3 | 4 | 14 | 4 | 69 | |
| 3 | 4 | 34 | 37 | 90 | |
| 3 | 5 | ||||
| 4 | 5 | -6 | 11 | 8 |
<tbody>
</tbody>
Let me explain how this test is supposed to work.
Column A represents the variable "depositDate" and column B represents the variable "saleDate."
In column D, negative numbers are completely ignored. In column E, these numbers are stored into a "special array" (arrSpecial). Everything else (column C:F, but not E) are stored into the regular array (arr). Zeros are to be ignored.
Each row represents a collection. However, if it just so happens that the deposit date and sales date are the same (see rows 1 & 2 and 4 & 5) then the macro should not be creating a new collection, and it should not be adding it to "Shortfalls" just yet; it should simply "append" the new data into the prior array.
I don't see any issues with the arrays, and it's not empty. Yet I get error 91. Any ideas why?
