• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 356
  • Last Modified:

Copy Data According to Date and Time

Hi Experts,

I would like to request Experts help create a macro which is able to disseminate (copy and paste) data from column D (Data sheet) to Week1 to Week5 sheets based on date and time at Data sheet (Column A). I have manually copied few data at Week1 and Week2 sheets for Experts to get better view. Hope Experts could help me create this feature.



Copy-Data.xls
0
Cartillo
Asked:
Cartillo
  • 8
  • 4
  • 4
2 Solutions
 
krishnakrkcCommented:
Hi,

Try


Kris
Sub kTest()
    
    Dim k(), ka, i As Long, d As Date, n As Long
    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) <> "data" Then
                With Worksheets(i)
                    ka = .Range("a2:h98")
                    For c = 2 To UBound(ka, 2)
                        For r = 3 To UBound(ka, 1)
                            s = ka(1, c) & "|" & ka(r, 1)
                            If dic.exists(s) Then ka(r, c) = dic.Item(s)
                        Next
                    Next
                    .Range("a2:h98") = ka
                    Erase ka
                End With
            End If
        Next
    End If
    
End Sub

Open in new window

0
 
CartilloAuthor Commented:
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
0
 
krishnakrkcCommented:
Hi,

I run the Kris2 again it filled all the sheets.

Kris
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
CartilloAuthor Commented:
Hi Kris,

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

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
0
 
CartilloAuthor Commented:
Hi Kris,

Shows error as "Type mismatch" at "s = CDate(ka(1, c)) & "|" & ka(r, 1)"
0
 
CartilloAuthor Commented:
Hi,

I'm just wondering how come 11-Nov data has been copied perfectly but other data were not.    
0
 
krishnakrkcCommented:
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

Open in new window

0
 
gowflowCommented:
Cartilo I hav ethe same problem and did your whole macro and it stops at 11/12/2011 and reason for this is the following:

You have a problem that the dates in Col A shows as dd/mm/yyyy but the dates in weeks are interpreted by your computer settings. the format used in Col A of Data sheet does not allow to change beteen date and month.

I have re-entered your dates in col A (they are all days of month of nuvember 2011 to match their real date value in sheet week).

pls try it and chk the results.

gowflow
Copy-DataNew.xls
0
 
CartilloAuthor Commented:
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
0
 
gowflowCommented:
Cartillo, did you Pls chk my solution ?
gowflow
0
 
gowflowCommented:
Pls let me know if my solution does not suits you. Appreciate your comments.
gowflow
0
 
CartilloAuthor Commented:
Hi Gowflow,

Bingo! it works superbly. Thanks a lot for the solution.
0
 
CartilloAuthor Commented:
Hi Gowflow/Kris,

Thanks a lot for the solution.
0
 
gowflowCommented:
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
0
 
CartilloAuthor Commented:
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.  


http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27426938.html
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

  • 8
  • 4
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now