PDA

View Full Version : Solved: insert code to show progress



jazznaura
07-20-2008, 11:00 AM
hi all,
got this code of this site for showing progress in the status bar, but i'm not sure were to insert it in my code.
i thinking if i place my code where it suggests it will run my code 250 times and as it takes over 10 mins i could be here for a while :) my code is in a userform, could anyone help me out?

any help would be greatfully received,
thanks
Option Explicit
Sub StatusBar()
Dim x As Integer
Dim MyTimer As Double

'Change this loop as needed.
For x = 1 To 250

'Dummy Loop here just to waste time.
'Replace this loop with your actual code.
MyTimer = Timer
Do
Loop While Timer - MyTimer < 0.03

Application.StatusBar = "Progress: " & x & " of 250: " & Format(x / 250, "Percent")
DoEvents

Next x
Application.StatusBar = False
End Sub
my code
Private Sub Category_Locations_Click()
Dim ws As Worksheet, rng As Range, c As Range, Fmt As Range, Cel As Range
User_Menu.Hide

'Reset the Locations
Call Clear_All_Click
Set ws = Sheets("Data")
Set Fmt = Sheets("Formats").Range("e4:e15")
Set rng = Sheets("Coventry").Range( _
"7:91,99:183,191:275,283:367,375:459,467:551,H551,559:559,559:559,560:643").SpecialCells(xlCellTypeConstants, 23)

'Highlights the Locations
For Each Cel In rng
Set c = ws.Range("B:B").Find(Cel, LookAt:=xlWhole).Offset(, 8)
On Error Resume Next
If Not c Is Nothing Then
Cel.Interior.ColorIndex = Fmt.Find(c.Text).Interior.ColorIndex
Cel.Font.ColorIndex = Fmt.Find(c.Text).Font.ColorIndex
Else
Cel.Font.ColorIndex = 1
Cel.Interior.ColorIndex = 2
End If
Set c = Nothing
Next
Range("A1").Select
End Sub

Bob Phillips
07-20-2008, 12:05 PM
Private Sub Category_Locations_Click()
Dim ws As Worksheet, rng As Range, c As Range, Fmt As Range, Cel As Range
User_Menu.Hide

'Reset the Locations
Call Clear_All_Click
Set ws = Sheets("Data")
Set Fmt = Sheets("Formats").Range("e4:e15")
Set rng = Sheets("Coventry").Range( _
"7:91,99:183,191:275,283:367,375:459,467:551,H551,559:559,559:559,560:643").SpecialCells(xlCellTypeConstants, 23)
Application.StatusBar = True

'Highlights the Locations
For Each Cel In rng

Application.StatusBar = "Progress: " & Cel.Address & " - " & Cel.Value
Set c = ws.Range("B:B").Find(Cel, LookAt:=xlWhole).Offset(, 8)
On Error Resume Next
If Not c Is Nothing Then
Cel.Interior.ColorIndex = Fmt.Find(c.Text).Interior.ColorIndex
Cel.Font.ColorIndex = Fmt.Find(c.Text).Font.ColorIndex
Else
Cel.Font.ColorIndex = 1
Cel.Interior.ColorIndex = 2
End If
Set c = Nothing
Next
Application.StatusBar = False
Range("A1").Select
End Sub

Simon Lloyd
07-20-2008, 12:07 PM
Don't insert it, call it in the top of your category sub:

Call StatusBar

jazznaura
07-20-2008, 12:57 PM
thanks for the replies,

went with a modified version of xld idea, a quick and simple solution.
thanks