Hi,
The code as follow was published in the comunity hope will help you as well

Sub StatusProgressBar(lCounter As Long, _
lMax As Long, _
bReset As Boolean, _
Optional lInterval As Long = 1, _
Optional strText As String, _
Optional lLength As Long = 100)

'lCounter the loop counter passed from the procedure
'lMax the maximum of the loop counter
'bReset do this at the very first iteration, eg i = 0
'lInterval the update interval of the statusbar
'strText any text preceding the progressbar
'lLength lenght in characters of the progressbar
'---------------------------------------------------------
Dim lStripes As Long
Static lLenText As Long
Static strBuffer As String
Static lOldStripes As Long

If bReset Then
lLenText = Len(strText)
strBuffer = strText
strBuffer = strBuffer & String(lLength, ".")
strBuffer = strBuffer & "|"
lOldStripes = 0
End If

If lCounter Mod lInterval = 0 Or lCounter = lMax Then
lStripes = Round((lCounter / lMax) * lLength, 0)
If lStripes - lOldStripes 0 Then
Mid$(strBuffer, lLenText + 1 + lOldStripes) = "|"
lOldStripes = lStripes
Application.StatusBar = strBuffer
End If
End If

End Sub

Sub test()

Dim i As Long
Dim strText As String

strText = " Looping through the range - "

For i = 1 To 6000000
StatusProgressBar i, 6000000, i = 1, 6000000 \ 200, strText
Next i

End Sub

Take a look to these webs

http://support.microsoft.com/kb/211736
http://j-walk.com/ss/excel/tips/tip34.htm
status bar....
http://www.cpearson.com/excel/StatusBar.htm

If this helped please click yes, thanks