'Author : Nathaniel N. Sumaya
'DateCreated: 20120620 1024H
'Purpose : Automate Calculation of %Increase/Decrease
'Credits : http://www.exceltip.com/st/Using_Loops_in_VBA_in_Microsoft_Excel/628.html
Sub CalculateIncrease()
Sheet1.Activate '
Activate the sheet 1
Range("P5").Activate ' Assign the active cell
'Inform the User that calculation is ongoing
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.StatusBar = "Please Wait...
Calculating % Increase/Decrease"
End With
Dim i As Integer
Dim intRowCount As Integer
'intRowCount = Range("A1").CurrentRegion.Rows.Count - 1
'intRowCount = Cells(Rows.Count,
"A").End(xlUp).Row
intRowCount = Cells(Rows.Count,
"A").End(xlUp).Row
'Dim currentRow As Integer
' currentRow = ActiveCell.Row
For i = 1 To intRowCount
If Range("L" &
ActiveCell.Row).Value > -1 Then 'Condition to determine if numerator is <> 0
'ActiveCell.FormulaR1C1
= "=(RC[-2]-RC[-4])/(RC[-2])"
ActiveCell.FormulaR1C1 =
"=IF(ISERROR((RC[-2]-RC[-4])/(RC[-2])),,(RC[-2]-RC[-4])/(RC[-2])*100)"
'Highlight cells <>
0
If
ActiveCell.Value >
0 Then
ActiveCell.Interior.ColorIndex = 6 ' Yellow
ElseIf ActiveCell.Value < 0 Then
ActiveCell.Interior.ColorIndex
= 7 '
End
If
ActiveCell.Offset(1, 0).Select
End If
Next i
With Application
.StatusBar
= False
.Calculation
= xlCalculationAutomatic
.ScreenUpdating
= True
End With
End Sub
