Add fixed value


How do I add a fixed value to a cell every month which is then automatically updated?




I have no idea how you do that.
I would set up another sheet in the work book with a column headed months and put the fixed value in that column The first column would be the start value 

I would have a formula where I wanted the result to sum the start value and all of the months values.

Alternatively (and more likely) I would have a sheet where I would save the las run date.

A button to run a macro which would ask for the fixed value. It would check to see if it had been run this month add the values and srore the run date. the date checking is to stop it running twice for the same month. As I got more lazy I would add this to workbook code sheet so that it ran when the workbook opened automaticaly.


Please paste the code below in the code module ThisWorkbook of a workbook which you set up for testing. Make sure the workbook has a worksheet called Sheet1 or change the sheet name at the top of the code. Save the workbook as macro-enabled.

Option Explicit

Private Sub Workbook_Open()
    ' 06 Sep 2019

    Const Target As String = "Sheet1!A3"            ' cell to increment: change as required
    Const Pname As String = "Last Increment"

    Dim Prop As DocumentProperty
    Dim Pdate As Variant
    Dim Ws As Worksheet                             ' worksheet specified in 'Target'
    Dim Rng As Range                                ' cell specified in 'Target'
    Dim Sp() As String
    Dim Mdiff As Long
    Dim OK As Boolean

    With CustomDocumentProperties
        On Error Resume Next
        Set Prop = .Item(Pname)
        If Err Then
            ' create the Property, if it didn't exist, with current date
            Set Prop = .Add(Pname, False, msoPropertyTypeDate, Date)
        End If
    End With
    Pdate = Prop.Value

    If Not IsDate(Pdate) Then
        ' If property isn't a date, assign current date
        Prop.Type = msoPropertyTypeDate
        Pdate = Date
    End If

    Sp = Split(Target, "!")
    OK = (UBound(Sp) = 1)
    If OK Then
        Set Ws = ThisWorkbook.Worksheets(Sp(0))
        Set Rng = Ws.Range(Sp(1))
        OK = (Err.Number = 0)
    End If
    If OK Then
        ' calculate the number of months lapsed since Last Increment
        ' the Dateserial formula calculates the date of the last day of the month in Pdate
        Mdiff = DateDiff("m", DateSerial(Year(Pdate), Month(Pdate) + 1, 0), Date)
        If Mdiff Then
            Rng.Value = Rng.Value + Increment(Mdiff)
            Prop.Value = Date
        End If
        MsgBox "The constant ""Target"" must specify an existing" & vbCr & _
               "worksheet, its name separated from the cell address" & vbCr & _
               "by an exclamation point.", vbCritical, "Coding Error"

    End If
End Sub

Private Function Increment(ByVal Mdiff As Long) As Double
    ' 06 Sep 2019

    Increment = 0.25 * Mdiff
End Function

The code will run automatically whenever the workbook is opened. But you can also run it manually by placing the cursor anywhere in the sub Workbook_Open and pressing F5. The comments I have added may help you understand what the code does but so will the explanation below.

The code looks for a custom document property (File > Properties > Advanced Properties > Custom) by the name of Last Increment (change the name in the code). If it doesn't exist, it will be added.

If the last increment was in a previous month (not: if one month has passed since) the Target cell will be incremented, meaning, a calculated value will be added to the existing one. At the same time the Last Increment property will be assigned the date of the action. (The property value can also be modified in the properties dialog.)

I placed the calculation of the increment in a separate function. That isn't strictly necessary but it provides the infrastructure to make the calculation quite complicated, if that is required. I proceded from the idea of an increasing rate of interest to be charged, or perhaps a monthly fee. This would require that several months' worth of increment should be added, if the update was missed previously. Toward this end the function receives the months-difference (Mdiff) as an argument.



Hi Variatus.
Very nice. 
I had a bit of a play and needed to change CustomProperties to ActiveWorkbook.CustomProperties. Mind you I had this in a standard module rather than the workbook module. 
Also not to sure about the OK = (Ubound(Sp) = 1)
and OK  = (err.number = 0)
It seems there is no way OK will ever be true to do the calculation.
k1w1sm (rep: 167) Sep 8, '19 at 9:11 pm
Hello k1, my code is tested. Since it’s in the ThisWorkbook module (compare the first line of my answer), specifying “ActiveWorkbook.CustomProperties” is superfluous, at best. It may cause an error if ActiveWorkbook <> ThisWorkbook - if that’s possible. 
The statements (UBound(Sp)=1) and (Err.Number=0) can each be either True or False, which are Boolean values that can be assigned to the Boolean variable OK. The effect is to display an error message if the Target address isn’t valid in some way. 
Variatus (rep: 2958) Sep 8, '19 at 11:30 pm
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login