VBA macro - change time format and select rows with specific month

[tuspilica]

Hi guys,

I have a big file with columns D & E that contains time of starting an action (D) and finishing the action (E).
I need the time in a custom format, like: mmmm dd, yyyy hh:mm:ss AM/PM
Records are from the last 2 years, but i'm interested in a specific month, let's say, January 2017 and to discard / eliminate the other rows, keeping only January month.

Is there any chance to create a macro to do the time conversion and filtering in these two columns?

Thank you

 

[Sektor]

Do I understand correctly that cells in D and E columns can have different time format?

 

[tuspilica]

hello Sektor,

cells D and E have the same time format
Let's say:
D start
01.02.2017 21:36:29
E end
01.02.2017 22:45:12

 

[Sektor]

1. As for setting the required format, everything is pretty straight-forward:

Columns("D:E").NumberFormat = "mmmm dd, yyyy hh:mm:ss AM/PM"

2. As for "eliminating/discarding", do you need to physically delete those rows or it'd be enough to hide them?

 

[tuspilica]

hello, deleting those rows it would be just fine.

 

[Sektor]

The fastest way is to filter target date so that dates for removing would remain. You can download workbook with code. Column D is a source of dates. The target date (to leave) is in H1 cell.

Sub DeleteDates()


    Dim x As Long, j As Long, last_row As Long
    Dim varValue As Variant, varKey As Variant
    Dim sTarget As String
    Dim dic As Object
    Dim arrDates() As Variant
    Const DATE_FORMAT$ = "mmmm, yyyy"


    Set dic = CreateObject("Scripting.Dictionary")


    Columns("D:E").NumberFormat = "mmmm dd, yyyy hh:mm:ss AM/PM"
    
    ActiveSheet.AutoFilterMode = False '//Remove filter if any
    sTarget = Format(Range("H1").Value, DATE_FORMAT)
    last_row = Cells(Rows.Count, "D").End(xlUp).Row
    
    With Range("D1:E" & last_row)
    
        '// Form array of dates for auto filter.
        
        '// 1. Get all distinct dates which do not equal to target date
        For x = 2 To last_row
            varValue = Cells(x, "D").Value
            If Format(varValue, DATE_FORMAT) <> sTarget Then
                varValue = Format(WorksheetFunction.EoMonth(varValue, 0), "m\/d\/yyyy")
                dic(varValue) = varValue
            End If
        Next
        
        '// 2. Fill up array of date to filter out
        j = -1
        For Each varKey In dic.Keys()
            j = j + 2
            ReDim Preserve arrDates(0 To j)
            arrDates(j - 1) = 1
            arrDates(j) = varKey
        Next
        
        '// Filtering column D
        .AutoFilter Field:=1, Criteria2:=arrDates, Operator:=xlFilterValues
        
        '// Delete filtered rows
        With .Offset(1).Resize(.Rows.Count - 1)
            .EntireRow.Delete
        End With
        
    End With
    
    ActiveSheet.AutoFilterMode = False '//Remove filter if any


End Sub

The reason for this lengthy code is the format the auto filter requires to filter dates.
There's also another way to deal with it: sort column D, determine previous row from the first source date and next row after last source date - and delete these two ranges. This method should work quicker (because range will be contiguous).

 

[tuspilica]

This is great!!!
Thank you very much!

 

[Sektor]

You're welcome!