How to put output, MsgBox Result on new column

user_18533818 0
Viewed 71

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?

Example of my spreadsheet

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
msgbox date-difference vba excel
3 Answers

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
user_98140690

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
user_22206650

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")
user_22206650
Related