We help IT Professionals succeed at work.

# Copy Unique Time

on
Hi Experts,

I would like to request Experts help create a macro code to copy only unique time for the week at column A (Data sheet) in column A Week1 to Week5 sheets. For Example, in Week1 sheet, the week date is from 1st Nov to 7th Nov. Therefore the time that we need to copy from Data Sheet (Column A) is from 1st Nov to 7th Nov, but the copied time at column A in Week1 sheet need to be unique. The start time of each date is at 00:00. Hope Expert could help me create this feature. Attached the workbook for Experts perusal.
Copy-DataNew.xls
Comment
Watch Question

## View Solution Only

CERTIFIED EXPERT

Commented:
What is the time interval for each sheet?

Commented:
Hi ssaqibh,

Most of the time the interval is 15 minutes, but sometime we do have time start at 23:05,19:55, 21:10 or 20:40 and that complicate the whole part for us to set an interval time. Hope you have better idea to handle this situation.

Commented:
Hi ssaqibh,

Let me know if you need more info. Hope my explanation is clear.

Commented:
Hi,

After crosschecked all data, the interval time can be set to 5mins.
CERTIFIED EXPERT
Commented:
Sorry for being away.

Try this macro

Sub fillweekdata()
Dim ws As Worksheet, dat As Range, rn As Long, rn2 As Long
For Each ws In ThisWorkbook.Worksheets
If LCase(Left(ws.Name, 4)) = "week" Then
ws.Select
Range("A4:A292").Formula = "=(row()-4)/288"
Range("A4:A292").Value = Range("A4:A292").Value
With Sheets("Data")
For Each dat In Range("b2:h2").Cells
If dat.Value <> "" Then
rn = WorksheetFunction.Match(dat, .Range("A:A"), 0) + 2
Do While .Cells(rn, 1) <> ""
rn2 = .Cells(rn, 1) * 288 + 4
Cells(rn2, dat.Column) = .Cells(rn, 3)
rn = rn + 1
Loop
End If
Next dat
End With
End If
Next ws
Set ws = Worksheets("data")

End Sub

Commented:
Hi ssaqibh,

Thanks for the help.