blairintern
New Member
- Joined
- Jul 16, 2007
- Messages
- 21
I am having difficulty with setting a loop to end when it has reached the end of an array (of objects of a user-defined class).
I will be the first to admit that the following code is not pretty, nor is it efficient. I welcome any suggestions whatsoever, but ultimately I need help getting this operation to run smoothly and effectively.
Here is the code which errors as I attempt to get the Array's elements to print out in my desired format.
The CALL MakeIssue above (bolded) calls this function which returns an array of IssueClass
I know this code isn't going to win awards for brevity or elegance, but I just need it to work properly.
Thanks for your help in advance!
I will be the first to admit that the following code is not pretty, nor is it efficient. I welcome any suggestions whatsoever, but ultimately I need help getting this operation to run smoothly and effectively.
Here is the code which errors as I attempt to get the Array's elements to print out in my desired format.
Code:
Sub DrawIssues()
Dim i As Integer ' used to keep track of index in array
Dim k As Integer ' used to keep track of time through loop
Dim xDeals As Double ' number of deals in array
Dim r As Integer
Dim factor As Integer
Call MakeIssue <-----------------Is this proper?
Sheets(2).Activate
Sheets(2).Range("A1").Select
r = 6
i = 0
xDeals = UBound(AllIssues) <---ERROR: Subscript out of Range
factor = 3 + (4 * i)
For k = 1 To xDeals
Do
With Sheets(2).Range("A1").Offset(r, factor)
If r = 6 Or r = 12 Then
If r = 6 Then
.Range("A1:D1").MergeCells = True
.Range("A1") = AllIssues(k).DatedDate
ElseIf r = 12 Then
.Range("A1") = "Amount"
.Range("D1") = "Coupon"
End If
.Interior.Color = RGB(255, 255, 224)
ElseIf r = 13 Or r = 14 Or r = 46 Or r = 51 _
Or r = 58 Then
.Interior.Color = RGB(255, 255, 255)
If r = 13 Then
.Range("A1:D1").MergeCells = True
.Range("A1") = AllIssues(k).Rating
End If
ElseIf r > 6 And r < 12 Then
.Range("A1:D1").MergeCells = True
.Range("A1:D1").Interior.Color = RGB(255, 255, 255)
If r = 7 Then
.Range("A1") = AllIssues(k).Obligation
ElseIf r = 8 Then
.Range("A1") = AllIssues(k).Series
ElseIf r = 9 Then
.Range("A1") = AllIssues(k).Par
ElseIf r = 10 Then
.Range("A1") = AllIssues(k).CallInfo
ElseIf r = 11 Then
.Range("A1") = AllIssues(k).Maturity
End If
ElseIf r > 14 And r < 46 Then
ElseIf r = 47 Then
.MergeCells = True
' .TextAlign (2)
.Interior.Color = RGB(204, 204, 204)
ElseIf r > 47 And r < 51 Then
.MergeCells = True
' .TextAlign (2)
.Interior.Color = RGB(255, 255, 255)
ElseIf r > 51 And r < 58 Then
' .TextAlign (2)
.Interior.Color = RGB(255, 255, 255)
ElseIf r > 58 And r <= 60 Then
.Interior.Color = RGB(255, 255, 255)
End If
If r <> 14 And r <> 46 And r <> 51 And _
r <> 58 And r <> 7 And r <> 8 And r <> 9 _
And r <> 10 And r <> 11 Then
Call BoxIt(Sheets(2).Range("a1:d1").Offset(r, factor))
End If
End With
r = r + 1
Loop Until r = 61
k = k + 1
i = i + 1
factor = 3 + (4 * i)
Next
End Sub
The CALL MakeIssue above (bolded) calls this function which returns an array of IssueClass
Code:
Function MakeIssue() As IssueClass()
Application.ScreenUpdating = False
Sheets(1).Activate
Sheets(1).Range("A1").Select
Dim i As Integer ' indicates the index of the loop
Dim n As Integer ' indicates what issue loop is on
i = 0
n = 1
' ReDim Preserve AllIssues(1 To n)
' redim AllIssues with loop to detect each issue.
Do
With Sheets(1).Range("A1")
If .Offset(i, 0) = "" Then
Set Deal = New IssueClass
Else
Set Deal = New IssueClass
Deal.Issue = .Offset(i, 2)
Deal.Purpose = .Offset(i, 2) & " " & .Offset(i, 4) _
& " " & .Offset(i, 5)
Deal.DatedDate = .Offset(i, 0)
Deal.Series = .Offset(i, 3)
If .Offset(i, 7) = "#" Then
Deal.Par = .Offset(i, 7)
End If
Deal.CallDate = .Offset(i, 8)
Deal.CallPrice = .Offset(i, 9)
Deal.Fitch = .Offset(i, 10)
Deal.Moody = .Offset(i, 11)
Deal.SandP = .Offset(i, 12)
Deal.Underwriter = .Offset(i, 16)
Deal.Counsel = .Offset(i, 17)
Deal.Refund = .Offset(i, 19)
' Deal.Insurance = .Offset(i, 25) ' not yet on form
n = n + 1
ReDim Preserve AllIssues(1 To n)
Set AllIssues(n) = Deal
End If
i = i + 1
End With
Loop Until i = 1000
MakeIssue() = AllIssues()
End Function
I know this code isn't going to win awards for brevity or elegance, but I just need it to work properly.
Thanks for your help in advance!