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

asked Feb 2, 2015 at 17:02
\$\endgroup\$

1 Answer 1

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.

answered Apr 16, 2015 at 16:17
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.