HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Average interval between dates with random blanks

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
randomblankswithdatesintervalaveragebetween

Problem

I have a spreadsheet with order date data:

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 DateInt()
Dim CurrentSheet 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

Set CurrentSheet = ActiveWorkbook.ActiveSheet
LastRow = CurrentSheet.Range("A" & Rows.Count).End(xlUp).Row - 1
LastCol = CurrentSheet.Cells(4, Columns.Count).End(xlToLeft).Column

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

For CurrentRow = 5 To LastRow
Cells(CurrentRow, LastCol).Value = Date
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

Cells(CurrentRow, LastCol + 1).Value = DateTtl / DateCount
Cells(CurrentRow, LastC

Solution

One thing that stands right out is formatting cells in each iteration of a loop. Less to do within each iteration should speed things up just a bit so why not just format the entire column after the loop has done all the calculations?

I am not sure sure if you are working with more than one workbook or if that's part of an automated process but

Set CurrentSheet = ActiveWorkbook.ActiveSheet
LastRow = CurrentSheet.Range("A" & Rows.Count).End(xlUp).Row - 1
LastCol = CurrentSheet.Cells(4, Columns.Count).End(xlToLeft).Column


seems like a bit of an overkill. You are not using the CurrentSheet (pascal case vs camel case you know) anywhere in the code but you don't quality the Cells. Why not just:

lastRow = Range("A" & Rows.Count).End(xlUp).Row - 1
lastCol = Cells(4, Columns.Count).End(xlToLeft).Column


Have you heard of offsets? Experience taught me that it's easier to maintain offsets rather than +1s +2s etc.

Cells(CurrentRow, LastCol + 1).Value = DateTtl / DateCount


=

Cells(currentRow, lastCol).Offset(0,1) = DateTtl / DateCount

Code Snippets

Set CurrentSheet = ActiveWorkbook.ActiveSheet
LastRow = CurrentSheet.Range("A" & Rows.Count).End(xlUp).Row - 1
LastCol = CurrentSheet.Cells(4, Columns.Count).End(xlToLeft).Column
lastRow = Range("A" & Rows.Count).End(xlUp).Row - 1
lastCol = Cells(4, Columns.Count).End(xlToLeft).Column
Cells(CurrentRow, LastCol + 1).Value = DateTtl / DateCount
Cells(currentRow, lastCol).Offset(0,1) = DateTtl / DateCount

Context

StackExchange Code Review Q#78451, answer score: 5

Revisions (0)

No revisions yet.