Hi MeTheITGuy,
Easy if you have Excel 2007. Otherwise you could try this macro to build
your own progress bars.
Option Explicit
Sub BuildBar()
' Builds rectangle shapes in column C
' for this sample we assume that the range A2:B6
' contains budget in col A, and actual in col B
' we want a bar in Col C that is proportional to
' col B / col A
Dim inpRange As Range
Dim actual As Range
Dim barLength As Double
' you could use an input box here to ask the user for a range
' or you could define a dynamic named range and use that
' leave it up to you
Set inpRange = Range("A2:B6")
' clean up any previously built rectangles
CleanUp
For Each actual In inpRange.Columns(1).Cells
barLength = actual.Offset(0, 1).Value / actual.Value
Call AddRectangle(actual.Offset(0, 2), barLength)
Next actual
End Sub
Sub AddRectangle(dest As Range, barLength As Double)
' Adds a rectangle shape to fill the specified cell
Dim cL, cT, cW, cH As Single
Dim shp As Shape
With dest
cL = .Left
cT = .Top
cW = .Width
cH = .Height
End With
Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, cL, cT, cW, cH)
With shp
' name the shapes so that we can keep track of them
.Name = "Rect" & dest.Address
' set a fill colour
.Fill.ForeColor.SchemeColor = 10
' size them to be proportional to barLength
.ScaleWidth barLength, msoFalse, msoScaleFromTopLeft
End With
End Sub
Sub CleanUp()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 4) = "Rect" Then
shp.Delete
End If
Next shp
End Sub
Ed Ferrero
