Advertisement

07.18.2008 at 09:54AM PDT, ID: 23577468 | Points: 500
[x]
Attachment Details

Please help me modify this macro to transform the time increment of time series data?

Asked by daviddiebel in Microsoft Excel Spreadsheet Software, Visual Basic Programming, VB Script

Tags: Microsoft, Excel, 2003

I need to somehow fix this macro so that it will modify any time series data with a date/time in column A into a data set using one hour time increments, so a 1000 row time series using 15 minute increments would be transformed into a 250 row time series using one hour time increments.  Perhaps an entirely new macro would be called for.  I would the data to be transformed so that the average of the respective time periods is given. So that if a variable "temperature" in column B give 55, 50, 60, 45 at 6:00, 6:15, 6:30 and 6:45, then the new one hour 6:00 temperature is the average of these, 52.5.  Is this possible?  Perhaps an entirely new macro would be called for.  In this one, I attempted to calculate a figure in cell U3 as follows that might be used to assist the aggregation:

   ActiveSheet.[U2].Value = "=R[1]C[-20]-RC[-20]"
    ActiveSheet.[U3].Value = "=ROUND(0.0416666666642413/R[-1]C,0)"

The value in cell U3 could be used somewhere in the code to determine the number of cells to average, but I'm not sure how.

Also, I want the macro to average as many columns of data as are present in the sheet (columns B - ??).

Thanks for any assistance!Start Free Trial 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:

Public Sub FifteenMinuteToHourly()
   Dim CurrentDate As Double
   Dim Count As Long
   Dim Sum As Double
   Dim Row As Range
   Dim TargetRow As Long
 
   Application.ScreenUpdating = False
   On Error Resume Next
   ActiveSheet.[K1:T1].Value = ActiveSheet.[A1:J1].Value
   ActiveSheet.[U2].Value = "=R[1]C[-20]-RC[-20]"
    ActiveSheet.[U3].Value = "=ROUND(0.0416666666642413/R[-1]C,0)"
   Range("U2:U3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Paste
    Application.CutCopyMode = False
   CurrentDate = ActiveSheet.[A2]
   CurrentDate = CDbl(Round(CurrentDate * 24 * 1)) / 24 / 1
   TargetRow = 2
   Count = 1
   For Each Row In ActiveSheet.UsedRange.Rows
      If IsDate(Row.Cells(1, 1)) Then
         If Row.Cells(1, 1) <= CurrentDate Then
            Sum = Sum + Row.Cells(1, 2)
            Count = Count + 1
         Else
            ActiveSheet.Cells(TargetRow, 11) = CurrentDate
            ActiveSheet.Cells(TargetRow, 11).NumberFormat = "M/D/YYYY HH:MM"
            Sum = Row.Cells(1, 1)
            ActiveSheet.Cells(TargetRow, 12) = Sum / Count
            ActiveSheet.Cells(TargetRow, 12).NumberFormat = "0.000"
            Sum = Row.Cells(1, 1)
            ActiveSheet.Cells(TargetRow, 13) = Sum / Count
            ActiveSheet.Cells(TargetRow, 13).NumberFormat = "0.000"
            Sum = Row.Cells(1, 1)
            ActiveSheet.Cells(TargetRow, 14) = Sum / Count
            ActiveSheet.Cells(TargetRow, 14).NumberFormat = "0.000"
            Sum = Row.Cells(1, 1)
            ActiveSheet.Cells(TargetRow, 15) = Sum / Count
            ActiveSheet.Cells(TargetRow, 15).NumberFormat = "0.000"
            Sum = Row.Cells(1, 1)
            ActiveSheet.Cells(TargetRow, 16) = Sum / Count
            ActiveSheet.Cells(TargetRow, 16).NumberFormat = "0.000"
            Sum = Row.Cells(1, 7)
            ActiveSheet.Cells(TargetRow, 17) = Sum / Count
            ActiveSheet.Cells(TargetRow, 17).NumberFormat = "0.000"
            Sum = Row.Cells(1, 8)
            ActiveSheet.Cells(TargetRow, 18) = Sum / Count
            ActiveSheet.Cells(TargetRow, 18).NumberFormat = "0.000"
            Sum = Row.Cells(1, 9)
            ActiveSheet.Cells(TargetRow, 19) = Sum / Count
            ActiveSheet.Cells(TargetRow, 19).NumberFormat = "0.000"
            Sum = Row.Cells(1, 10)
            ActiveSheet.Cells(TargetRow, 20) = Sum / Count
            ActiveSheet.Cells(TargetRow, 20).NumberFormat = "0.000"
            Sum = Row.Cells(1, 10)
            Count = 1
            CurrentDate = CurrentDate + TimeSerial(0, 60, 0)
            TargetRow = TargetRow + 1
         End If
      End If
   Next Row
   ActiveSheet.[A:J].Delete
   Application.ScreenUpdating = True
 
End Sub
Attachments:
 
1289336.xls (264 KB) (File Type Details) 
Example
 
[+][-]07.18.2008 at 02:00PM PDT, ID: 22039770

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
 
Loading Advertisement...
20080716-EE-VQP-32 / EE_QW_2_20070628