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
1 Answer 1
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.