Run VBA Script When Cell Value Change by Formula

Question

I need to run a VBA script everytime the value of cell "H18" changes, but contains a formula, and no data is changed "Manually" only by VBA scripts, is there a way to set it up? I've tried a bunch of VBA scripts but no success at all, it works if I change it manually, but not when the formula works. This is the VBA script it should run:

Sub Colorir()

Application.ScreenUpdating = False
    Dim iRow, contagem

    contagem = 0
    iRow = 18
    iColumn = 2
'    ifim = Sheets("Plan1").Range("C8").Value - 1

    Sheets("Calendario").Select


Do While iRow < 30

If Cells(iRow, 2) = "Não Recebido" Then

Cells(iRow, 2).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 8420607
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -8356609
        .TintAndShade = 0
    End With
    Else

    End If


       If Cells(iRow, 2) = "Abaixo do Previsto" Then

Cells(iRow, 2).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
        With Selection.Font
        .color = -16711681
        .TintAndShade = 0
    End With
    Else

    End If

If Cells(iRow, 2) = "Igual ou Acima do Previsto" Then

Cells(iRow, 2).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -6684826
        .TintAndShade = 0
    End With
    Else

    End If
    If Cells(iRow, 3) = "Não Recebido" Then

Cells(iRow, 3).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 8420607
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -8356609
        .TintAndShade = 0
    End With
    Else

    End If


       If Cells(iRow, 3) = "Abaixo do Previsto" Then

Cells(iRow, 3).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -16711681
        .TintAndShade = 0
    End With
    Else

    End If

If Cells(iRow, 3) = "Igual ou Acima do Previsto" Then

Cells(iRow, 3).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -6684826
        .TintAndShade = 0
    End With
    Else

    End If
    If Cells(iRow, 4) = "Não Recebido" Then

Cells(iRow, 4).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 8420607
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -8356609
        .TintAndShade = 0
    End With
    Else

    End If


       If Cells(iRow, 4) = "Abaixo do Previsto" Then

Cells(iRow, 4).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -16711681
        .TintAndShade = 0
    End With
    Else

    End If

If Cells(iRow, 4) = "Igual ou Acima do Previsto" Then

Cells(iRow, 4).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -6684826
        .TintAndShade = 0
    End With
    Else

    End If
    If Cells(iRow, 5) = "Não Recebido" Then

Cells(iRow, 5).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 8420607
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -8356609
        .TintAndShade = 0
    End With
    Else

    End If


       If Cells(iRow, 5) = "Abaixo do Previsto" Then

Cells(iRow, 5).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -16711681
        .TintAndShade = 0
    End With
    Else

    End If

If Cells(iRow, 5) = "Igual ou Acima do Previsto" Then

Cells(iRow, 5).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -6684826
        .TintAndShade = 0
    End With
    Else

    End If

    If Cells(iRow, 6) = "Não Recebido" Then

Cells(iRow, 6).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 8420607
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -8356609
        .TintAndShade = 0
    End With
    Else

    End If


       If Cells(iRow, 6) = "Abaixo do Previsto" Then

Cells(iRow, 6).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -16711681
        .TintAndShade = 0
    End With
    Else

    End If

If Cells(iRow, 6) = "Igual ou Acima do Previsto" Then

Cells(iRow, 6).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -6684826
        .TintAndShade = 0
    End With
    Else
    End If


If Cells(iRow, 7) = "Não Recebido" Then

Cells(iRow, 7).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 8420607
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -8356609
        .TintAndShade = 0
    End With
    Else

    End If


       If Cells(iRow, 7) = "Abaixo do Previsto" Then

Cells(iRow, 7).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -16711681
        .TintAndShade = 0
    End With
    Else

    End If

If Cells(iRow, 7) = "Igual ou Acima do Previsto" Then

Cells(iRow, 7).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -6684826
        .TintAndShade = 0
    End With
    Else

    End If

If Cells(iRow, 8) = "Não Recebido" Then

Cells(iRow, 8).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 8420607
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -8356609
        .TintAndShade = 0
    End With
    Else

    End If


       If Cells(iRow, 8) = "Abaixo do Previsto" Then

Cells(iRow, 8).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -16711681
        .TintAndShade = 0
    End With
    Else

    End If

If Cells(iRow, 8) = "Igual ou Acima do Previsto" Then

Cells(iRow, 8).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
            With Selection.Font
        .color = -6684826
        .TintAndShade = 0
    End With
    Else
    End If


    If Range("S18").Value < Range("T18").Value Then
    Range("B18, C18, D18, E18, F18, G18, H18").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

        If Range("S18").Value > Range("T18").Value Then
    Range("B18, C18, D18, E18, F18, G18, H18").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If
            If Range("T18").Value = 0 Then
    Range("B18, C18, D18, E18, F18, G18, H18").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 8420607
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

        If Range("S20").Value < Range("T20").Value Then
    Range("B20, C20, D20, E20, F20, G20, H20").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

        If Range("S20").Value > Range("T20").Value Then
    Range("B20, C20, D20, E20, F20, G20, H20").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If
            If Range("T20").Value = 0 Then
    Range("B20, C20, D20, E20, F20, G20, H20").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 8420607
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

        If Range("S22").Value < Range("T22").Value Then
    Range("B22, C22, D22, E22, F22, G22, H22").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

        If Range("S22").Value > Range("T22").Value Then
    Range("B22, C22, D22, E22, F22, G22, H22").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If
            If Range("T22").Value = 0 Then
    Range("B22, C22, D22, E22, F22, G22, H22").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 8420607
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

        If Range("S24").Value < Range("T24").Value Then
    Range("B24, C24, D24, E24, F24, G24, H24").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

        If Range("S24").Value > Range("T24").Value Then
    Range("B24, C24, D24, E24, F24, G24, H24").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If
            If Range("T24").Value = 0 Then
    Range("B24, C24, D24, E24, F24, G24, H24").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 8420607
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

        If Range("S26").Value < Range("T26").Value Then
    Range("B26, C26, D26, E26, F26, G26, H26").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 10092390
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

        If Range("S26").Value > Range("T26").Value Then
    Range("B26, C26, D26, E26, F26, G26, H26").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If
            If Range("T26").Value = 0 Then
    Range("B26, C26, D26, E26, F26, G26, H26, B28, C28").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 8420607
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

 iRow = iRow + 1
 iColumn = iColumn + 1

 Loop
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++



If Range("B18, B19").Value = "" Then
Range("B18,B19").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else


    End If
If Range("C18, C19").Value = "" Then
Range("C18,C19").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If


If Range("D18, D19").Value = "" Then
Range("D18,D19").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else


    End If
If Range("E18, E19").Value = "" Then
Range("E18,E19").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If


If Range("E18, E19").Value = "" Then
Range("E18,E19").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else


    End If
If Range("F18, F19").Value = "" Then
Range("F18,F19").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If


If Range("G18, G19").Value = "" Then
Range("G18,G19").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else


    End If
If Range("H18, H19").Value = "" Then
Range("H18,H19").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If


If Range("B28, B29").Value = "" Then
Range("B28,B29").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else


    End If
If Range("C28, C29").Value = "" Then
Range("c28,c29").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

    If Range("d28, d29").Value = "" Then
Range("d28,d29").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

    If Range("e28, e29").Value = "" Then
Range("e28,e29").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

    If Range("f28, f29").Value = "" Then
Range("f28,f29").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

    If Range("g28, g29").Value = "" Then
Range("g28,g29").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

        If Range("h28, h29").Value = "" Then
Range("h28,h29").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

             If Range("D26, d27").Value = "" Then
Range("D26,D27").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

            If Range("e26, e27").Value = "" Then
Range("e26,e27").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If


            If Range("f26, f27").Value = "" Then
Range("f26, f27").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If


            If Range("g26, g27").Value = "" Then
Range("g26, g27").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

            If Range("h26, h27").Value = "" Then
Range("h26,h27").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
.color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0

     End With
    Else
    End If

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Range("Q6").Select
Application.ScreenUpdating = True
End Sub

hey Diego, what is the macro doing after the cell is changed manually? — Sico, Mar 14 '14 at 19:19
The formula in H18 is "=H8" and formula in H8 is "=if(Dina1!H5="";"";Dina1!H5)" the macro is pretty huge, I'll edit it on question. — Diego Patrocinio, Mar 14 '14 at 19:28
I think this could accomplish what you're looking for: http://stackoverflow.com/a/11409569/1693085 — John Bustos, Mar 14 '14 at 19:35

score 2 · Answer 1 · answered Apr 04 '16 at 14:48

You may also store information of your cell value with an Static variable, after the sub ends:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Value1 As Variant Static Value2 As Variant

Value1 = Range("B2005").Value
If Value1 <> Value2 Then
MsgBox "Cell " & Target.Address & " has changed."
End If

Value2 = Range("B2005").Value
End sub

score 1 · Accepted Answer · answered Mar 14 '14 at 19:40

You have to use a cell to keep track of previous value. In the below procedure "AnotherCell" is used for keeping the previous value and "FormulaCell" is where you have formula. Then use the below procedure on your worksheet code remember not in Workbook or Module page.

Private Sub Worksheet_Calculate()
    If Range("AnotherCell") <> Range("FormulaCell").Value Then
        Range("AnotherCell") = Range("Formula").Value
        'Your Code Here
    End If
End Sub

score 0 · Answer 3 · edited May 08 '18 at 21:49

0

Check out this article on Events in Excel VBA

You can write code in the Worksheet_Change event procedure to take some action depending on which cell was changed or based upon the newly changed value. (The Worksheet_Change event might more properly be called Worksheet_AfterChange since it is called after the cell(s) has been changed

edited May 08 '18 at 21:49

Community

1
1

answered Mar 14 '14 at 19:35

tmoore82

1,857
1
27
48

score 0 · Answer 4 · answered Aug 27 '16 at 08:21

0

it works only if you have one cell that changes. If you have a table, and you don't know when and which cell changes, but you want to run a macro when anything in the table changes, and it is changed by formula.

answered Aug 27 '16 at 08:21

Culi

1

score 0 · Answer 5 · edited May 11 '23 at 14:29

0

Put this in the code of the worksheet, and change the Cell Ranges and your Macro name

Private Sub Worksheet_Calculate()
    Dim Xrg As Range
    Set Xrg = Range("C2:C8")
    If Not Intersect(Xrg, Range("C2:C8")) Is Nothing Then
    Macro1
    End If
End Sub

edited May 11 '23 at 14:29

General Grievance

4,555
31
31
45

answered May 05 '23 at 21:52

Brian

1

Run VBA Script When Cell Value Change by Formula

5 Answers5

Linked