Calculate Month Differences Using DateDiff
Option Explicit
Sub UpdateMonthDifferences()
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim rrg As Range
Dim rCount As Long
With ws.Range("C2")
Dim lCell As Range: Set lCell = .Resize(ws.Rows.Count _
- .Row + 1).Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Sub ' no data in column range
rCount = lCell.Row - .Row + 1
Set rrg = .Resize(rCount)
End With
Dim prg As Range: Set prg = rrg.EntireRow.Columns("I")
Dim rData As Variant, pData As Variant
If rCount = 1 Then
ReDim rData(1 To 1, 1 To 1): rData(1, 1) = rrg.Value
ReDim pData(1 To 1, 1 To 1): pData(1, 1) = prg.Value
Else
rData = rrg.Value: pData = prg.Value
End If
Dim r As Long
For r = 1 To rCount
If IsDate(rData(r, 1)) And IsDate(pData(r, 1)) Then
rData(r, 1) = DateDiff("m", rData(r, 1), pData(r, 1))
Else
rData(r, 1) = Empty
End If
Next r
Dim drg As Range: Set drg = rrg.EntireRow.Columns("J")
drg.Value = rData
MsgBox "Month differences updated.", vbInformation
End Sub
Office 365: Evaluate with DATEDIF
- Office 365 users should be able to get away with the following simplifications.
- I don't have 365 so your feedback is appreciated.
Excel DATEDIF function
Sub UpdateMonthDifferencesEval()
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim rrg As Range
With ws.Range("C2")
Dim lCell As Range: Set lCell = .Resize(ws.Rows.Count _
- .Row + 1).Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Sub ' no data in column range
Set rrg = .Resize(lCell.Row - .Row + 1)
End With
Dim rAddress As String: rAddress = rrg.Address
Dim pAddress As String: pAddress = rrg.EntireRow.Columns("I").Address
Dim drg As Range: Set drg = rrg.EntireRow.Columns("J")
drg.Value = ws.Evaluate("DATEDIF(" & rAddress & "," & pAddress & ",""M"")")
MsgBox "Month differences updated.", vbInformation
End Sub