CODEWITHSUNDEEP
exceldateexcel-formula
pao13
pao13

Reputation: 1

Remove dates from a column

I have a column with dates (column A) that are sorted from oldest to newest. I don't want this column to have dates that are apart closer than 32 days if the date that has to be removed is in column B.

An example to understand.

Column A      Column B      "Target Column"
07/02/2006    20/01/2006     07/02/2006
11/02/2006    17/02/2006     11/02/2006
17/02/2006    17/03/2006     17/03/2006
17/03/2006    21/04/2006     21/04/2006
21/04/2006    19/05/2006
19/05/2006

In column A starting from 07/02/2006 the next date is 11/02/2006 but it is not included in column B so it has to stay. A3 is 17/02/2016 which is only 6 days away from A2 and is included in column B. So A3 has to go. Now, A4=17/03/2006 will stay because it's 34 days apart from A3=17/02/2016. etc.

Upvotes: 0

Views: 210

Answers (1)

Forward Ed
Forward Ed

Reputation: 9874

ok I am going to post some code below. It is not the most elegant code as I am not trained in VBA and I am still learning it myself.

I did note one problem and it had me banging my head against the wall for a couple of hours. It does not appear to work when your date columns are serial dates formatted to display in a date format. It works right when working with the date values though. The VBA application function for VLOOKUP cant match items in the list when the date value is formatted as a date for some reason.

Option Explicit


Sub removedates()

Dim counter As Integer
Dim MaxDays As Integer
Dim Datelist() As Variant
Dim NumberofDates As Integer
Dim RemoveDateList As Range
Dim RemoveDate As Boolean
Dim RemoveDays As Boolean
Dim Doesitexist As Variant

MaxDays = 32

Range("A1").Select
Datelist = Range(Selection, Selection.End(xlDown))
Range("B1").Select
Set RemoveDateList = Range(Selection, Selection.End(xlDown))

NumberofDates = UBound(Datelist)
counter = 2

While counter <= NumberofDates
    Doesitexist = Application.VLookup(Datelist(counter, 1), RemoveDateList.Value, 1, False)
    RemoveDate = Not (IsError(Doesitexist))
    RemoveDays = MaxDays > Datelist(counter, 1) - Datelist(counter - 1, 1)
    If RemoveDate And RemoveDays Then
        Call Removefromlist(Datelist, counter)
        counter = counter - 1
        NumberofDates = NumberofDates - 1
    End If
    counter = counter + 1
Wend

Range(Cells(1, 3), Cells(UBound(Datelist), 3)) = Datelist

End Sub


Sub Removefromlist(arr As Variant, rowtodelete As Integer)

Dim temp As Variant
Dim i As Integer

If rowtodelete = UBound(arr) Then
    arr(rowtodelete) = ""
Else
    For i = rowtodelete To UBound(arr) - 1
        arr(i, 1) = arr(i + 1, 1)
    Next i
    arr(UBound(arr), 1) = ""
End If

End Sub

I placed the list of dates into an array as apparently that is faster than dealing with cells and ranges. one of the limits is you cant delete from arrays apparently so I added the second sub to move all dates up the list by 1 row then replace the last entry with "". So even though the cell below your new list may look blank, they are not really.

Upvotes: 1

Related Questions