I am tracking payments made on a large excel file. In column C, I have the date we received the payment, in column I, I have the date paid. I'd like to calculate how many months between column C (when we rcvd invc) and column I (when invc was paid).
I also want to have the results (number of months) add to a column to the right of my data instead of just in the output messagebox. Can I do this in VBA EXCEL?
I've used the below code but I cant figure out how to change the msgbox result to show on a new column...
Sub DateDiff_Example1()
Dim Date1 As Date
Dim Date2 As Date
Dim Result As Long
Date1 = Range("C2")
Date2 = Range("I2")
Result = DateDiff("M", Date1, Date2)
MsgBox Result
End Sub
CodePudding user response:
One way would be to use a loop as follows:
Sub DateDiff_Example2()
Dim Date1 As Date
Dim Date2 As Date
Dim Result As Long
Dim row As Long
Dim last_row As Long
Dim s As Worksheet
Set s = ActiveSheet ' operate on the active sheet
'set s= thisworkbook.Worksheets("Sheet1")' operate on a specific sheet
last_row = s.Cells(s.Rows.Count, "C").End(xlUp).row
For row = 2 To last_row
Date1 = s.Cells(row, "c").Value
Date2 = s.Cells(row, "I").Value
s.Cells(row, "J").Value = DateDiff("M", Date1, Date2)
Next
End Sub
Be careful. This will replace all data in column "J". If column "J" is not the right one, be sure to change "J" in the following code to be the output column letter:
s.Cells(row, "J").Value
CodePudding user response:
Another way to do it would be to use the Excel function of the same name. Just put this formula in row 2 of the column where you want the date:
=DATEDIF(C2,I2,"M")
CodePudding user response:
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