Help with clearing a ReDim Preserve Array

[Nyanko]

Hi,
The code, below, is used to find a list of start and end dates from a matrix grid. I have been able to save the values in an array and output the results... however the results are weird. Each loop should output pairs of dates but its adding in lots of commas in the successive columns. I'm guessing that the array never really clears and the new values are simply appending onto the end. I can't seem to get rid of this.

Sub FindDates()
    
Dim DATA As Worksheet:           Set DATA = Worksheets("New Data")
Dim LastRow, LastCol As Long
Dim x, y As Long
Dim MyDay() As Variant

DATA.Select
With ActiveSheet
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

'PROCESS EACH CELL IN THE CHOSEN ROW AND DETERMINE IF IT IS A START OR END DATE
For MyRow = 2 To LastRow
    DATA.Range(Cells(MyRow, 11), Cells(MyRow, LastCol)).Select
    For Each rCell In Selection
        'IF THE WHOLE ROW IS NEEDED
        If WorksheetFunction.CountA(Range(Cells(MyRow, 11), Cells(MyRow, LastRow))) = WorksheetFunction.CountA(Range(Cells(1, 11), Cells(1, LastRow))) Then
            ReDim Preserve MyDay(x)
            MyDay(x) = Cells(1, rCell.Column).Value
            x = x + 1
            ReDim Preserve MyDay(x)
            MyDay(x) = Cells(LastRow, rCell.Column).Value
            x = x + 1
            GoTo NextRow
        End If
        'CHECK IF THE FIRST VALUE IS A START DATE
        If IsEmpty(rCell.Value) = False And IsEmpty(rCell.Offset(0, 1).Value) = False And rCell.Column = 11 Then
            ReDim Preserve MyDay(x)
            MyDay(x) = Cells(1, rCell.Column).Value
            x = x + 1
        End If        
        'IF CELL VALUE IS NOT EMPTY AND THE VALUE BEFORE AND AFTER IS EMPTY = SINGLE DAY (IGNORED)
        If IsEmpty(rCell.Value) = False And IsEmpty(rCell.Offset(0, 1).Value) = True And IsEmpty(rCell.Offset(0, -1).Value) = True Then
            GoTo NextCell
        End If
        'IF CELL VALUE IS NOT EMPTY AND THE VALUE BEFORE IS EMPTY = FIRST DAY
        If IsEmpty(rCell.Value) = False And IsEmpty(rCell.Offset(0, -1).Value) = True Then
            ReDim Preserve MyDay(x)
            MyDay(x) = Cells(1, rCell.Column).Value
            x = x + 1
        End If
        'IF CELL VALUE IS NOT EMPTY AND THE VALUE AFTER IS EMPTY = LAST DAY
        If IsEmpty(rCell.Value) = False And IsEmpty(rCell.Offset(0, 1).Value) = True Then 'CELL IS NOT BLANK AND NEXT CELL IS EMPTY
            ReDim Preserve MyDay(x)
            MyDay(x) = Cells(1, rCell.Column).Value + 6
            x = x + 1
        End If
NextCell:
    Next rCell
NextRow:

DATA.Range("BL" & MyRow).Value = Join(MyDay, ",")
ReDim MyDay(0) As Variant

Next MyRow
End Sub

The results should output like this :
01/01/2018,05/01/2018,15/02/2018,19/02/2018
05/01/2018,31/01/2018
10/02/2018,11/02/2018
etc...

however it's returning
01/01/2018,05/01/2018,15/02/2018,19/02/2018
,,,,05/01/2018,31/01/2018
,,,,,,10/02/2018,11/02/2018
each row with preceding commas which I'm guessing represent an empty dimension of the array MyDay ?

I would welcome any advice on how to improve my code or solve this problem
Kind Regards

 

[pvr928]

Hi Nyanko

Sounds like you need to step through your code and see that it is working as expected. Start with a small sample of data so you know what the results should be in advance, and then step through the code and check that MyDay(x) at a particular value for x returns the result you expect.

Given you are using quite a few IF statements, it could be an issue with the logic rather with how the array is being populated.

It may not be relevant in error hunting in this situation, but in my humble experience, I only use Redim Preserve when I don't know in advance the dimension of my array. Is there a particular reason why you can't determine the size of the array before you start populating it?

Also, to make your code faster (but really the difference will only be noticeable if you are working with tens of thousands of rows), consider write the initial worksheet range to an array, and then process that array into your 'sorted' array, rather than going back to the worksheet each time you write to your array. My principle is: Write from the worksheet once; process the data; write back to the worksheet once.

Cheers

pvr928

 

[Rick Rothstein]

Based on a fast look (so I could be wrong), it looks like the problem is with X... it appears to always be increasing. I think setting X=0 immediately after the first For statement (so the next For statement starts off with X=0) might fix your problem.

 

[John_w]

Difficult to help without knowing how the sheet data is laid out, but in the following statement shouldn't you be using LastCol instead of LastRow (2 instances)?

        If WorksheetFunction.CountA(Range(Cells(MyRow, 11), Cells(MyRow, LastRow))) = WorksheetFunction.CountA(Range(Cells(1, 11), Cells(1, LastRow))) Then

 

[shg]

Can you explain in words and sentences how your data is arranged, what it means, and what the code is supposed to do?