Application onEntry with IF then statement

T

TR

I am having trouble trying to get a value to change in a cell.
I need my if statement to be executed each time a cell has changed.

I have tried using a sub to call the calculation sub, but the value of
the changed cell is still not recognized.

For example if I enter '18' in the cell B2, then I get the correct
calculation, if I enter '55', the formula still looks at the < 30
equation.

I really need help....

Thanks so much

This is where i call the sub

Public Sub Main()
Application.OnEntry = "TargetRenewal"
End Sub

This is the calculation sub
Public Sub TargetRenewal()
Dim Intx As Integer
Dim lngRow As Long
Dim lastrow As Long
Dim iCol As Long
Dim iRow As Long
Dim daysvac As Integer

Application.ScreenUpdating = False
Cells(1, 1).Select

daysvac = Range("$b$2").Value
ActiveCell.SpecialCells(xlLastCell).Select
lngRow = 1750

With ActiveSheet
For iRow = 2 To lngRow
If InStr(1, .Cells(iRow, 2).Value, "appw1d",
vbTextCompare) Then
If LCase(.Cells(iRow, 1).Value) = LCase(" Target
Renewal") Then
For iCol = 6 To 20
'looks to see if row above formula cell is 0
If .Cells(iRow - 1, iCol).Value = 0 _
And IsEmpty(.Cells(iRow - 1, iCol)) = False Then
If .Cells(iRow, iCol - 1).Value = 0 _
And IsEmpty(.Cells(iRow, iCol - 1)) = False _
And daysvac < 90 _
And daysvac > 60 Then
.Cells(iRow, iCol + 2).Formula =
"=VLOOKUP(""appw1d"",$f$1:$g$16,2,FALSE)*(1-($b$2-60)/30)"

ElseIf Cells(iRow, iCol - 1).Value = 0 _
And IsEmpty(.Cells(iRow, iCol - 1)) = False _
And daysvac < 60 _ ' this line does not re-evaluate
And daysvac > 30 Then
.Cells(iRow, iCol + 1).Formula =
"=VLOOKUP(""appw1d"",$f$1:$g$16,2,FALSE)*(1-($b$2-30)/30)"

ElseIf Cells(iRow, iCol - 1).Value = 0 _
And IsEmpty(.Cells(iRow, iCol - 1)) = False _
And daysvac + .Cells(iRow - 1, iCol).Value < 30 Then
.Cells(iRow, iCol).Formula =
"=VLOOKUP(""appw1d"",$f$1:$g$16,2,FALSE)*(1-$b$2/30)"

ElseIf .Cells(iRow - 1, iCol).Value = 0 _
And IsEmpty(.Cells(iRow - 1, iCol)) = False Then
.Cells(iRow, iCol).Formula =
"=VLOOKUP(""appw1d"",$f$1:$g$16,2,FALSE)"
End If
End If
Next iCol
End If
End If
Next iRow
End With

Application.ScreenUpdating = True
'return to left/first cell of spreadsheet
Range("A1").Activate
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top