CODEWITHSUNDEEP
excelvbaformula
Crypt0x0a
Crypt0x0a

Reputation: 13

How can I change my Worksheet_Change code to change the value of cells when a formula is triggered automatically

My Excel Sheet Example

The purpose of my worksheet is to input client information into the required cells like the image I posted above. Every new day, the DateCounter column will increase by one.

DateCounter formula : =IFERROR(IF(ISBLANK(B3),"",TODAY()-B3),"") (Today's date - B3 the date the row was created = how many days have passed since the row was created.)

After it's increased by one automatically, I want the Interest column to update automatically and make it equal to itself + the Per Diem of that row. (Exemple : [I3 Interest = I3 Interest + H3 Per Diem].

I have a VBA code that does exactly this but it only works when I change the DateCounter cell manually and not when the formula gets triggered automatically.

VBA CODE :

'*If "day" range is changed, update Interest cell*'

Private Sub Worksheet_Change(ByVal target As Range)

    If Not Intersect(target, Range("N3:N400")) Is Nothing Then

        Range("I" & target.Row).Value = Range("I" & target.Row).Value + Range("H" & target.Row)

        'Change Interest cell to the accounting format
        Range("I" & target.Row).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    End If
End Sub

I tried to change the code into the Worksheet_Calculate() event but It triggers every row in the column and my excel sheet crashes because of an infinite loop. I tried the example [here] . I also tried other examples but my knowledge of VBA is limited and I can't seem to get this task to work.

Upvotes: 1

Views: 87

Answers (1)

user4039065
user4039065

Reputation:

Formula changes do not trigger Worksheet_Change. You need Worksheet_Calculate and a static var. 

Option Explicit

Private Sub Worksheet_Calculate()
    Static tday As Long

    If Date <> tday Then
        tday = Date
        'suspend calculation so you don't run on top of yourself
         application.calculation = xlcalculationmanual

        'do all the update work here
        range(cells(2, "H"), cells(rows.count, "H").end(xlup)).copy
        cells(2, "I").pastespecial Paste:=xlPasteValues, Operation:=xlAdd


        'resume automatic calculation
         application.calculation = xlcalculationautomatic
    End If
End Sub

Upvotes: 2

Related Questions