VB6 - Why is using Redim Preserve for an array inside a while-wend causes to reset the array after the loop?

Experts,

I have the following code. It redims an array inside the loop, but when it comes out of the loop, the Dates() array is reset!

Please correct me!
Dim RS As New Recordset
           RS.Open "SELECT MAX(IKey) FROM M_Main_Calendar", CN, adOpenForwardOnly
           Me.txt_EventIKey = VAL(RS(0) & "") + 1
           
           Dim valueDate As Date, EDate As Date, Dates() As Date
           If Me.opt_EndAfter.Value = True Then
           ElseIf Me.opt_EndByDate.Value = True Then
              EDate = Me.txt_EDate.Value
           End If
           
           valueDate = Me.txt_SDate.Value
           i = 0
           
           While valueDate <= EDate
                  
                  ReDim Preserve Dates(i)
                  
                  If Me.chk_WorkingDays.Value = vbChecked And (Format(valueDate, "ddd") = "FRI" Or Format(valueDate, "ddd") = "SAT") Then
                     i = i - 1
                  Else
                     Dates(i) = valueDate
                  End If
                  
                  Select Case Me.cbo_Recurrence.Text
                         Case "Daily"
                              valueDate = DateAdd("d", 1, valueDate)
                         Case "Weekly"
                              If Format(valueDate, "dddd") = Me.cbo_WeekDays.Text Then
                                 Dates(i) = valueDate
                              Else
                                 i = i - 1
                              End If
                              valueDate = DateAdd("d", 1, valueDate)
                         Case "Monthly"
                              If Me.opt_Monthly_Day_BOM.Value = True Then
                                 valueDate = Format(DateAdd("m", 1, valueDate), "1/mm/yyyy")
                              ElseIf Me.opt_Monthly_Day_EOM.Value = True Then
                                 valueDate = DateAdd("d", -1, Format(DateAdd("m", 2, valueDate), "1/mm/yyyy")) 'DateAdd("m", DateSerial(Year(valueDate), Month(valueDate), 1)) - 1
                              ElseIf Me.opt_Monthly_Day_Custom.Value = True Then
                                 valueDate = DateAdd("m", 1, valueDate)
                              End If
                  End Select
                  i = i + 1
           Wend
           
           For i = 0 To UBound(Dates()) - 1
               Me.Form_Insert Me.txt_EventIKey, _
                              VAL(Uno), _
                              Me.txt_head, _
                              Me.txt_body, _
                              Me.txt_SDate.Value, _
                              EDate, _
                              Dates(i)
           Next

Open in new window

feesuAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Louis01Commented:
What happens if you change
ReDim Preserve Dates(i)
to
If i > UBound(Dates) then ReDim Preserve Dates(i)
?
0
feesuAuthor Commented:
Then it gives a "Subscript out of range" error on the first loop.
0
Louis01Commented:
If i = 0 then
      ReDim Preserve Dates(i)
else
      If i > UBound(Dates) then ReDim Preserve Dates(i)
end if
0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Chris BottomleySoftware Quality Lead EngineerCommented:
Hello feesu,

Are you sure your operations on 'i' are doing what you want ... you potentially decrement it in a few paths so the subsequent increment may be setting it back to the value before the loop?  i.e. it is not the preserve that is failing rather the incremental redim by virtue of the fact that 'i' isn't working right.  You could put a few debug traces in each time i is changed to see what happens ...

                     i = i - 1
debug.print "i Decremented by Fri/Sat check to: " & i


Regards,
Chris
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
feesuAuthor Commented:
Louis01,
The code didn't solve the bug. However, it didn't give the first error anymore.

Chris,
I shall check that and get back.
0
Louis01Commented:
Your routine would decrease the value of the array by 2 everytime you hit the following condition:
If valueDate = "FRI" or "SAT" AND chk_WorkingDays is checked AND cbo_Recurrence = "Monthly" .

Perhaps you can explain what you are trying to do?
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Louis01

Wow! why didn't I think of that ... oh wait I did ... you ought to refresh the screen a bit more often.

Chris
0
feesuAuthor Commented:
Experts,

I have fixed my bug. It works fine now. Attached is the new code.

Thank you all.
           Dim RS As New Recordset
           RS.Open "SELECT MAX(IKey) FROM M_Main_Calendar", CN, adOpenForwardOnly
           Me.txt_EventIKey = VAL(RS(0) & "") + 1
           
           Dim valueDate As Date, EDate As Date, Dates() As Date
           If Me.opt_EndAfter.Value = True Then
                                                         
           ElseIf Me.opt_EndByDate.Value = True Then
              EDate = Me.txt_EDate.Value
           End If
             
           valueDate = Me.txt_SDate.Value
           i = 0
           
           While valueDate <= EDate
                  
                  ReDim Preserve Dates(i)
                  
                  If Me.chk_WorkingDays.Value = vbChecked And (Format(valueDate, "ddd") = "Fri" Or Format(valueDate, "ddd") = "Sat") Then
                     i = i - 1
                  Else
                     Dates(i) = valueDate
                  End If
                  
                  Select Case Me.cbo_Recurrence.Text
                         Case "Daily"
                              valueDate = DateAdd("d", 1, valueDate)
                         Case "Weekly"
                              If Format(valueDate, "dddd") = Me.cbo_WeekDays.Text Then
                                 Dates(i) = valueDate
                              Else
                                 i = i - 1
                              End If
                              valueDate = DateAdd("d", 1, valueDate)
                         Case "Monthly"
                              If Me.opt_Monthly_Day_BOM.Value = True Then
                                 valueDate = Format(DateAdd("m", 1, valueDate), "1/mm/yyyy  HH:mm")
                              ElseIf Me.opt_Monthly_Day_EOM.Value = True Then
                                 valueDate = DateAdd("d", -1, Format(DateAdd("m", 2, valueDate), "1/mm/yyyy  HH:mm")) 'DateAdd("m", DateSerial(Year(valueDate), Month(valueDate), 1)) - 1
                              ElseIf Me.opt_Monthly_Day_Custom.Value = True Then
                                 valueDate = DateAdd("m", 1, valueDate)
                              End If
                  End Select
                  i = i + 1
           Wend
           
           Me.ProgressBar1.Min = 0
           Me.ProgressBar1.Max = UBound(Dates())
           For i = 0 To UBound(Dates()) '- 1
               Me.Form_Insert Me.txt_EventIKey, _
                              VAL(Uno), _
                              Me.txt_head, _
                              Me.txt_body, _
                              Me.txt_SDate.Value, _
                              EDate, _
                              Dates(i)
               
               Me.ProgressBar1.Value = i
           Next
           Me.ProgressBar1.Value = 0
           MsgBox i & " note(s) added successfully.", vbInformation

Open in new window

0
Chris BottomleySoftware Quality Lead EngineerCommented:
At the risk of seeming fascetious, well done to resolve the structure yourself.

I looked out of interest to see what you changed but it is not obvious, (maybe the removal of -1 in the last loop) so it was perhaps as well that you did work it out yourself as it may have taken us longer to drill down to the root cause.

Anyway again well done, glad to have helped a little.

Chris
0
Louis01Commented:
facetious - you chris? never...
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.