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?
 
Chris BottomleyConnect With a Mentor Software 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
 
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
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Louis01Commented:
If i = 0 then
      ReDim Preserve Dates(i)
else
      If i > UBound(Dates) then ReDim Preserve Dates(i)
end if
0
 
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.