Copy Data According to Date and Time

Hi Kris,

Have tried, only one date was copied to week sheet (11-Nov-week 2), other date were not copied to week sheets. Attached the result of it. Please assist.
Copy-Data.xls

Hi,

I run the Kris2 again it filled all the sheets.

Kris

Hi Kris,

I have tried few times, its continuously ignoring other data except for 11-Nov. Do I need to activate any object?

I'm not sure what went wrong. Anyway

replace

s = ka(1, c) & "|" & ka(r, 1)

with

s = CDate(ka(1, c)) & "|" & ka(r, 1)

Kris

Hi Kris,

Shows error as "Type mismatch" at "s = CDate(ka(1, c)) & "|" & ka(r, 1)"

Hi,

I'm just wondering how come 11-Nov data has been copied perfectly but other data were not.    

Hi,

Try this.

Kris

Sub kTest_v1()
    
    Dim k(), ka, i As Long, d As Date, n As Long, x
    Dim dic As Object, r As Long, c As Long, s As String
    
    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)
    
    Set dic = CreateObject("scripting.dictionary")
        dic.comparemode = 1
    For i = 1 To UBound(ka, 1)
        If ka(i, 1) Like "*(*)" Then d = CDate(Left$(ka(i, 1), 8)): GoTo Nxt
        If Len(ka(i, 3)) Then
            dic.Item(d & "|" & ka(i, 1)) = ka(i, 3)
        End If
Nxt:
    Next
    n = dic.Count
    Erase ka
    If n Then
        For i = 1 To Worksheets.Count
            If LCase$(Worksheets(i).Name) Like "week*" Then
                With Worksheets(i)
                    ka = .Range("a2:h98")
                    For c = 2 To UBound(ka, 2)
                        For r = 3 To UBound(ka, 1)
                            If Len(ka(1, c)) Then
                                s = ka(1, c)
                                x = Split(Replace(s, "/", "-"), "-")
                                s = DateSerial(IIf(Len(x(2)) = 2, 2000 + x(2), x(2)), x(1), x(0)) & "|" & ka(r, 1)
                                If dic.exists(s) Then ka(r, c) = dic.Item(s)
                            End If
                        Next
                    Next
                    .Range("a2:h98") = ka
                    Erase ka
                End With
            End If
        Next
    End If
    
End Sub

Select allOpen in new window

Hi Kris,

Thanks for the revised script. Now the date are copied perfectly from 1-nov to 12-nov, however, 13 to 30 still empty. Enclosed the test result.
Copy-Data.xls

Cartillo, did you Pls chk my solution ?
gowflow

Pls let me know if my solution does not suits you. Appreciate your comments.
gowflow

Hi Gowflow,

Bingo! it works superbly. Thanks a lot for the solution.

Hi Gowflow/Kris,

Thanks a lot for the solution.

your wlecome  !! But you will need to fix your col A as mentioned for the months to come if it is input manually then I guess no sweat for you if it is dumped by some program make sure it dump only the date and not the (Tues) after it and always dump the date in the same format that you put it in row 2 of your weeks if it is Month/day/year then be it same thing in Col A of sheet Data

Also you have choosen format as date for these cells in Col A of sheet Data and the type is *3/14/2001 if you simply right click (on your old file that you submited) on a cel of those and choose format cell you will see that Date format is chosen and at the bottom if you read the text it says that Date format display date and time serial numbers as date value except format with * which is the one selected and the system convert the date in the cel to a serial number reason why we were not finding the dates in week2 as from day 13 the system was interpreting it as Month 13 which does not exist.

Anyway glad we could help you
gowflow

Hi gowflow,

Thanks a lot for the detail explanation. I will make sure the date is correctly entered.
I hope you will consider this Q. If not mistaken we can combine this new request in your solution.  


https://www.experts-exchange.com/questions/27426938/Highlight-Cell.html