Hello,
I have been using the code from this thread:
http://www.excelforum.com/excel-prog...and-times.html
It works very well, except that it does not change the date when crossing midnight. i.e. It will go 30/10/12 23:00 then 30/10/12 00:00 then 31/10/12 01:00. Of course, this means that the matching formula does not place the data in the correct place. When I type the formula directly into cells, it works perfectly and changes the date in the expected place. So it is something that the procedure is doing in VBA that stops this from working correctly and I can't for the life of me figure out what, which implies it is something very simple (usually the case!)
I think it is something to do with formatting, as I have added in some formatting otherwise it always returns no data. The code is below.
'Source http://www.excelforum.com/excel-programming-vba-macros/767543-adding-rows-of-missing-dates-and-times.html
'This code relies on date information in Column A and one dataset in Column B, if you run other macro first, data will be ready
'This will automatically copy the new dataset (without dates) ready for paste into analysis sheet
Sub AddMissing()
Dim FirstTime As Double
Dim LastTime As Double
Dim Rws As Long
Dim LR As Long
Application.ScreenUpdating = False
Worksheets("Sheet1").Activate
LR = Range("A" & Rows.Count).End(xlUp).Row
FirstTime = Range("A1").Value
LastTime = Range("A" & LR).Value
Rws = ((LastTime - FirstTime) / TimeValue("01:00")) + 1
'Add a new column of dates, ensuring there are no missing ones
Range("D1") = FirstTime
'Range("D1").NumberFormat = "dd/mm/yyyy hh:mm"
With Range("D2:D" & Rws)
'.NumberFormat = "dd/mm/yyyy hh:mm"
.FormulaR1C1 = "=R[-1]C + ""01:00"""
.Value = .Value
End With
'Match the data to dates that are available in both the old and the new date columns and report 'no data' if missing
With Range("E1:E" & Rws)
.FormulaR1C1 = "=IF(ISNUMBER(MATCH(RC4, C1, 0)), INDEX(C2, MATCH(RC4, C1, 0)), ""nodata"")"
.Value = .Value
End With
Application.ScreenUpdating = True
'Copies new data to clipboard
Range("E1:E" & Rws).Copy
'To tidy things up, you can enable the below line of code and be left with only the new dataset
'Range("A:C").Delete xlShiftToLeft
End Sub
Thankyou in advance for any help.
Bookmarks