We help IT Professionals succeed at work.

Copy Date

Cartillo
Cartillo asked
on
Hi Experts,
I would like to request Experts help. The attached the script has been used to copy only unique data from Column C (Data Sheet) to Detail sheet.

However, after I modified the Date from original format (previously the date is tagged with a day reference e.g. 12/11/2011(Tues) into standard date format (d/m/yyyy), the macro no logger copying the date value in Detail sheet (Column A).   Hope Experts will help me get the date value of the title. Attached the workbook for Experts perusal.
Sub Filter()
    
    Dim k(), ka, I As Long, d As String, n As Long, c As Long
    
    With Worksheets("Data")
        ka = .Range("a6:d" & .Range("a" & .Rows.Count).End(xlUp).Row)
    End With
    
    ReDim k(1 To UBound(ka, 1), 1 To 5)
    
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For I = 1 To UBound(ka, 1)
            If ka(I, 1) Like "*(*)" Then d = ka(I, 1): GoTo Nxt
            If Len(ka(I, 3)) Then
                If Not .exists(ka(I, 3)) Then
                    n = n + 1: k(n, 1) = d
                    For c = 1 To UBound(ka, 2)
                        k(n, c + 1) = ka(I, c)
                    Next
                    .Add ka(I, 3), Nothing
                End If
            End If
Nxt:
        Next
    End With
    If n Then
        With Worksheets("Detail")
            Union(.Range("b2").Resize(n), .Range("e2").Resize(n)).NumberFormat = "[h]:mm"
            .Range("a2").Resize(n, UBound(k, 2)) = k
        End With
    End If
    
End Sub

Open in new window

Date-Filter.xls
Comment
Watch Question

Most Valuable Expert 2012
Top Expert 2012
Commented:
Code documentation would help.  At any rate, I believe the line:

            If ka(I, 1) Like "*(*)" Then d = ka(I, 1): GoTo Nxt

Looks for ka(I,1) to be a date with (Tues) or some weekday inside parens to identify that that line in the spreadsheet is a date.

Let's take the same approach with this command:

            If IsDate(ka(I, 1)) Then d = ka(I, 1): GoTo Nxt

It seems to repair the problem!

Here's the revised code:

 
Sub Filter()
    
    Dim k(), ka, I As Long, d As String, n As Long, c As Long
    
    With Worksheets("Data")
        ka = .Range("a6:d" & .Range("a" & .Rows.Count).End(xlUp).Row)
    End With
    
    ReDim k(1 To UBound(ka, 1), 1 To 5)
    
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For I = 1 To UBound(ka, 1)
            If IsDate(ka(I, 1)) Then d = ka(I, 1): GoTo Nxt ' Like "*(*)" Then
            If Len(ka(I, 3)) Then
                If Not .exists(ka(I, 3)) Then
                    n = n + 1: k(n, 1) = d
                    For c = 1 To UBound(ka, 2)
                        k(n, c + 1) = ka(I, c)
                    Next
                    .Add ka(I, 3), Nothing
                End If
            End If
Nxt:
        Next
    End With
    If n Then
        With Worksheets("Detail")
            Union(.Range("b2").Resize(n), .Range("e2").Resize(n)).NumberFormat = "[h]:mm"
            .Range("a2").Resize(n, UBound(k, 2)) = k
        End With
    End If
    
End Sub

Open in new window


See attached,

Dave
Date-Filter-r1.xls

Author

Commented:
Hi Dave,

Thanks a lot for the help.

Explore More ContentExplore courses, solutions, and other research materials related to this topic.