Run VBA Script When Cell Value Change by Formula

1
votes

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
4
vbaexcel
hey Diego, what is the macro doing after the cell is changed manually? – Sico
Please show us the formula in cell H18 – Alex P
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
I think this could accomplish what you're looking for: stackoverflow.com/a/11409569/1693085 – John Bustos
I've tried it and didn't works.. – Diego Patrocinio

4 Answers

2
votes

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
1
votes

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
0
votes

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

0
votes

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.