Floating Total

Imagine this if you will. You are writing a ‘financial model’ in Excel and the person you are writing it for wants to see a ‘Running Total’ figure on permanent display as the figures in the model are adjusted. Oh that’s easy we just put in cell A1 and freeze the panes. No I don’t want you to do it that way I want something that floats over the top of the model so the user can move it but which they cannot move.

You’ve done a fair amount of work manipulating Icon Bars in the past so you decide that there may be scope to use an ‘Edit’ box on a floating Icon Bar. You start to hunt around the newsgroups and you quickly re-discover what you found when you first played with Icon Bars that there is very little of any substance written down, and what there is falls in to one of two categories, incomplete or ambiguous.

I didn’t get where I am today……

The first thing we need to do is have a routine that creates a Floating Command Bar and puts an Edit Control on it with an appropriate value:

Sub CreateCB

Dim cbCustBar as CommandBar

Dim cbcControl as CommandBarControl

Dim strWBName as String

Dim strCBName as String

strWBName = ThisWorkbook.Name

strCBName = Left(strWBName, Len(strWBName) - 4)

Set cbCustBar = Application.CommandBars.Add(strCBName)

With cbCustBar

.Position = msoBarFloating

.Visible = True

.Protection = msoNoChangeVisible

End With

Set cbcControl = cbCustBar.Controls.Add(Type:=msoControlEdit)

With cbcControl

.Enabled = True

.Text = Sheets(“Sheet1”).Range(“A1”).Value

.Enabled = False

.Width = 100

End With

End Sub

What this will give you is a grey box with slightly darker grey text. You can’t do much with it because it doesn’t seem to have many properties that you can adjust but it does what was asked for.

The next thing you need to do is make sure you keep it update. As you can see I have it picking up the value of call A1 from Sheet1. That cell is set to the equation “=100000-SUM(Sheet2!A1:A10)”. Therefore what we need is something in the ‘Change’ event of Sheet2 that will adjust the value in the control every time something changes it. The following code is placed in the Sheet2 module.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cbCustBar as CommandBar

Dim cbcControl as CommandBarControl

strWBName = ThisWorkbook.Name

strCBName = Left(strWBName, Len(strWBName) - 4)

Set cbCustBar = Application.CommandBars(strCBName)

Set cbcControl = CommandBars(strCBName).Controls(1)

With cbcControl

.Enabled = True

.Text = Sheets(“Sheet1”).Range(“A1”).Value

.Enabled = False

End With

End Sub

This may not be a very elegant solution but it does what was asked for. You are severely limited by what the Edit Control is capable of.