Advertisement

10.08.2008 at 12:24PM PDT, ID: 23798715 | Points: 500
[x]
Attachment Details

My macro isn't working.  What's wrong?

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

Tags: , ,

The attached code is supposed to calculate the percentage time something is "on" during a 15-minute interval.  The raw data are contained in columns A and B (date/time column A and a dummy variable with 1 or 0 value in column B).  The raw data have no regular time interval.  The macro creates new columns with standard 15-minute increments and the quantity of switches on (1 value) during the time interval and, crucially, the percentage time on during the 15 minute increment.  The problem is that the last entries in the raw data don't appear to be recognized by the macro, resulting in erroneous percentages on.

Anyone see the problem in the macro?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:

Public Sub FifteenMinuteIndicatorRoutine()
   
Dim CurrentDate As Date
   Dim Sum As Long
   Dim TotalTime As Date
   Dim Row As Range
   Dim TargetRow As Long
   Dim FirstTime As Boolean
   
   
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   ActiveSheet.[C1].Value = ActiveSheet.[a1].Value
   CurrentDate = ActiveSheet.[A2]
   CurrentDate = CDbl(Round((CurrentDate + TimeSerial(0, 14, 59)) * 24 * 4)) / 24 / 4
   TargetRow = 2
   For Each Row In ActiveSheet.UsedRange.Rows
      If IsDate(Row.Cells(1, 1)) Then
         If Row.Cells(1, 1) <= CurrentDate Then
            If Row.Cells(1, 2) = 1 Then
               Sum = 1
            Else
               If Row.Cells(0, 2) = 1 Then TotalTime = TotalTime + Row.Cells(1, 1) - Application.Max(Row.Cells(0, 1), CurrentDate - TimeSerial(0, 15, 0))
            End If
         Else
            FirstTime = True
            Do
               ActiveSheet.Cells(TargetRow, 3) = CurrentDate
               ActiveSheet.Cells(TargetRow, 3).NumberFormat = "M/D/YYYY HH:MM"
               ActiveSheet.Cells(TargetRow, 4) = Sum
               ActiveSheet.Cells(TargetRow, 4).NumberFormat = "0"
               If Row.Cells(1, 2) = 0 And FirstTime Then
                  TotalTime = TotalTime + CurrentDate - Application.Max(Row.Cells(0, 1), CurrentDate - TimeSerial(0, 15, 0))
                  FirstTime = False
               End If
               ActiveSheet.Cells(TargetRow, 5) = TotalTime / TimeSerial(0, 15, 0)
               ActiveSheet.Cells(TargetRow, 5).NumberFormat = "0.000"
               Sum = Row.Cells(1, 2)
               If Row.Row = 10000 Then Stop
               CurrentDate = CurrentDate + TimeSerial(0, 15, 0)
               CurrentDate = Round(CurrentDate * 24 * 60 * 60) / 24 / 60 / 60
               If Row.Cells(1, 2) = 0 Then
                  TotalTime = Application.Min(Row.Cells(1, 1), CurrentDate) - (CurrentDate - TimeSerial(0, 15, 0))
               Else
                  TotalTime = 0
               End If
               TargetRow = TargetRow + 1
            Loop Until CurrentDate >= Row.Cells(1, 1)
         End If
      End If
   Next Row
 
   
   
   
    Range("D2").Select
  ActiveCell.FormulaR1C1 = _
         "=IF(R[1]C[-1]<>"""",SUMPRODUCT((R2C[-3]:R10000C[-3]>=RC[-1]-1/96)*(R2C[-3]:R10000C[-3]<RC[-1])*R2C[-2]:R10000C[-2]),"""")"
    Selection.AutoFill Destination:=Range("D2:D10000"), Type:=xlFillDefault
 
Application.ScreenUpdating = True
 
End Sub
[+][-]10.08.2008 at 01:12PM PDT, ID: 22672840

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.

 
[+][-]10.08.2008 at 01:14PM PDT, ID: 22672864

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.

 
[+][-]10.08.2008 at 03:59PM PDT, ID: 22674305

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

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

 
[+][-]10.09.2008 at 12:18AM PDT, ID: 22676221

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.

 
[+][-]11.29.2008 at 11:56PM PST, ID: 23062338

Experts Exchange has a courteous staff of administrators who help members get the most out of the website by means of administrative comments like this one.

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

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