4
\$\begingroup\$

Original question:

Average interval between dates with random blanks

I have a spreadsheet with order date data:

enter image description here

I need to find the average interval in days between each order date. I have to both find a way to get past the blank cells in the row, and also take into account that some clients have 5-10 orders and some clients have 2 orders when calculating my average frequency (interval) between orders.

Sub DateIntervalRetailerOrderPattern()
    Dim CurS As Worksheet
    Dim LastRow As Integer
    Dim LastCol As Integer
    Dim CurrentRow As Integer
    Dim CurrentCol As Integer
    Dim GrandT As String
    Dim DateA As Date
    Dim DateB As Date
    Dim DateTtl As Integer
    Dim DateCount As Integer
    Dim StRow As Integer
    Dim JanYear As Date

    Set CurS = ActiveWorkbook.ActiveSheet        
    Dim response
    response = MsgBox("Do you want to execute on " & CurS.Name & " ?", vbYesNo, "Correct Sheet?")
    If response = vbNo Then Exit Sub

    StRow = 0
    StRow = InputBox("Enter the first row (Contains 'Row Labels' and 'Grand Total')", "First Row")
    If StRow = 0 Then Exit Sub

    JanYear = DateSerial(1990, 1, 1)
    JanYear = DateSerial(InputBox("What year does January 1 split your data using four digits as '20xx'"), 1, 1)
    If JanYear = DateSerial(1990, 1, 1) Then Exit Sub

    LastRow = Range("A" & Rows.Count).End(xlUp).Row - 1
    LastCol = Cells(StRow, Columns.Count).End(xlToLeft).Column

    Cells(StRow, LastCol + 1).Value = "Avg Interval"
    Cells(StRow, LastCol + 2).Value = "Days Since Last Order"
    Cells(StRow, LastCol + 3).Value = "Last Order Date"
    Cells(StRow, LastCol + 4).Value = "Last Order v Avg Order"
    Cells(StRow, LastCol + 5).Value = "Total Orders"

    For CurrentRow = StRow + 1 To LastRow
        Cells(CurrentRow, LastCol).Value = Date 'Can update to end of year if requested
        Cells(CurrentRow, LastCol).NumberFormat = "mm/dd/yy"
        DateCount = 0
        DateTtl = 0
        DateC = DateAdd("d", 20, Date)
        For CurrentCol = 2 To LastCol
            If Cells(CurrentRow, CurrentCol).Value = "" Then
                Else
                If DateCount < 1 Then
                    DateA = Cells(CurrentRow, CurrentCol).Value
                    Else
                    DateB = Cells(CurrentRow, CurrentCol).Value
                    DateTtl = DateDiff("d", DateA, DateB) + DateTtl
                    If DateValue(DateB) = DateValue(Date) Then
                    Else
                    DateA = DateB
                    End If
                End If
                DateCount = DateCount + 1
            End If
            Next CurrentCol
        DateCount = DateCount - 1
        If DateCount = 1 Then
            Cells(CurrentRow, LastCol + 1).Value = "One Order"
            Cells(CurrentRow, LastCol + 1).NumberFormat = "General"
            Cells(CurrentRow, LastCol + 2).Value = DateDiff("d", DateA, Date)
            Cells(CurrentRow, LastCol + 2).NumberFormat = "General"
            Cells(CurrentRow, LastCol + 3).Value = DateA
            Cells(CurrentRow, LastCol + 3).NumberFormat = "mm/dd/yy"
            Cells(CurrentRow, LastCol + 4).Value = "One Order"
            Cells(CurrentRow, LastCol + 4).NumberFormat = "General"
            If Cells(CurrentRow, LastCol + 3).Value < JanYear Then
                Cells(CurrentRow, LastCol + 4).Style = "Bad"
            Else
                Cells(CurrentRow, LastCol + 4).Style = "Neutral"
            End If
            Cells(CurrentRow, LastCol + 5).Value = DateCount
        Else
            Cells(CurrentRow, LastCol + 1).Value = DateTtl / DateCount
            Cells(CurrentRow, LastCol + 1).NumberFormat = "General"
            Cells(CurrentRow, LastCol + 2).Value = DateDiff("d", DateA, Date)
            Cells(CurrentRow, LastCol + 2).NumberFormat = "General"
            Cells(CurrentRow, LastCol + 3).Value = DateA
            Cells(CurrentRow, LastCol + 3).NumberFormat = "mm/dd/yy"
            Cells(CurrentRow, LastCol + 4).Value = Cells(CurrentRow, LastCol + 1).Value - Cells(CurrentRow, LastCol + 2).Value
            Cells(CurrentRow, LastCol + 4).NumberFormat = "#,##0_);[Red](#,##0)"
            If Cells(CurrentRow, LastCol + 4).Value < 0 Then
                Cells(CurrentRow, LastCol + 4).Style = "Bad"
            Else
                Cells(CurrentRow, LastCol + 4).Style = "Good"
            End If
            Cells(CurrentRow, LastCol + 5).Value = DateCount
        End If
    Next CurrentRow

MsgBox "Done"

End Sub

Here is what my code ended up doing:

enter image description here

\$\endgroup\$
5
\$\begingroup\$

It's a pretty lengthy procedure you have here. And when things start like this:

Sub DateIntervalRetailerOrderPattern()
    Dim CurS As Worksheet
    Dim LastRow As Integer
    Dim LastCol As Integer
    Dim CurrentRow As Integer
    Dim CurrentCol As Integer
    Dim GrandT As String
    Dim DateA As Date
    Dim DateB As Date
    Dim DateTtl As Integer
    Dim DateCount As Integer
    Dim StRow As Integer
    Dim JanYear As Date

Then you can be at least 70% sure that some of them aren't used anywhere. You can Ctrl+F each one of them and try to locate usages and non-usages of each individual declared variable here...

Or you can run Rubberduck code inspections:

Rubberduck Code Inspections - 4/16/2015 12:10:52 PM
5 issues found.
Warning: Variable 'GrandT' is never used - VBAProject.Module1, line 7
Warning: Option Explicit is not specified - VBAProject.Module1, line 1
Warning: Variable 'GrandT' is never assigned - VBAProject.Module1, line 7
Warning: Member 'DateIntervalRetailerOrderPattern' is implicitly Public - VBAProject.Module1, line 1
Warning: Variable 'response' is implicitly Variant - VBAProject.Module1, line 16

Assuming Option Explicit is not defined at the top of your module (you didn't include it), you have a handful of issues here, and - oh surprise, variable GrandT is never assigned or referred to, and can be safely removed.

The solution is to declare variables as close as possible to their usage, and to avoid that wall-of-declarations at the beginning of a procedure.


Then you can extract functions and procedures, and make the code shorter and more focused - i.e. easier to follow.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.