Performance indicator - VB script

S

Sandip Shah

Hi,

I would appreciate someone's help on getting the following macro
correct in the way I would like it to perform.

I have a file which measures key elements for eg. Revenue, net etc...

What the macro does -

Plan/Budget figures for the full year are mentioned in Col D.
Actual figures are entered in col DE, DF, and DG titled Jan., Feb.,
and Mar.,
The Actual figures are added in Col DC titled YTD (performed by the
Macro).
The Actual figures are annualised and compared to Plan.
A horizontal bar is created either in Green, Yellow or Red depending
on the performance.
A vertical line showing objective passes through the horizontal bars.

Change required.

I wish to compare the Quarterly Plan figures with Quarterly Actual
figures. However when I try to change the macro slighly, it doesn't
work.

I am not good at VB and hence find it difficult to understand the
logic below and make the appropriate change.

The above description and the below macro may not be clear in the
absence of viewing the file and to see exactly how it works.

I am willing to forward the file to anyone. I would appreciate
someone's help on this.

Sub Macro1()
'
' Macro1 Macro
'
Sheets("MEA Score Card").Select
Range("A1").Select
nb = Range("fin").Row - Range("y_01").Row - 1
Range(Range("y_01").Offset(1, 1), Range("y_01").Offset(nb,
100)).Interior.ColorIndex = 0

mois = Range("month").Offset(1, 0)
mm = mois * 100 / 12
sr = 0.8 + 0.2 * (mois - 1) / 11
sg = 1

For d = 0 To nb + 1 Step nb + 1
Range(Range("y_01").Offset(d, 1), Range("y_01").Offset(d,
100)).Interior.ColorIndex = 15
Next d

For d = 1 To nb
If Range("y_01").Offset(d, -2).Font.Bold = True Then
Range(Range("y_01").Offset(d, 1), Range("y_01").Offset(d,
100)).Interior.ColorIndex = 15
If IsEmpty(Range("y_01").Offset(d, 0)) Then GoTo 50
sytd = 0
For i = 1 To mois
xmois = Range("Jan").Offset(d, i - 1).Value
sytd = sytd + xmois
Next i
Range("ytd").Offset(d, 0).Value = sytd
50
Next d

For d = 1 To nb
If Range("y_01").Offset(d, -2).Font.Bold = True Then
Range(Range("y_01").Offset(d, 1), Range("y_01").Offset(d,
100)).Interior.ColorIndex = 15
If IsEmpty(Range("y_01").Offset(d, 0)) Then GoTo 100

xmax = Range("y_01").Offset(d, 0).Value
xytd = Range("ytd").Offset(d, 0).Value

x% = WorksheetFunction.Min(Int(xytd * 100 / xmax + 0.5), 100)
If xmax > 0 Then
If x% < sr * mm Then
Rem: Red=3 Green=4 Yellow=6
coul = 3
ElseIf x% >= sg * mm Then coul = 4
Else: coul = 6
End If
If x% > 0 Then Range(Range("y_01").Offset(d, 1),
Range("y_01").Offset(d, x%)).Interior.ColorIndex = coul
Range("ytd").Offset(d, 0).Interior.ColorIndex = coul
End If
If xmax < 0 Then
If x% < sr * mm Then
coul = 4
ElseIf x% >= sg * mm Then coul = 3
Else: coul = 6
End If
If x% > 0 Then Range(Range("y_01").Offset(d, 1),
Range("y_01").Offset(d, x%)).Interior.ColorIndex = coul
Range("ytd").Offset(d, 0).Interior.ColorIndex = coul
End If
100
Next d
Range(Range("y_01").Offset(0, mm), Range("y_01").Offset(nb + 1,
mm)).Interior.ColorIndex = 34
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