Progress indicator help wanted

[Cerberus]

I have a macro that takes about 30 to 40 seconds to run and I would like a
progress indicator to run while while the macro runs. The macro hides
anything that has a zero value in column A, starting at row 5 and finishing
on row 7818. I have a User Form that has a frame and lable that I was going
to use to indicate the progress. The issue, for me atleast, is creating the
formula to make the progress bar work.

Thanks for any ideas on how to write the fromula in advance.

 

[ryguy7272]

Ah, yes! I remember when i did this for the very first time. It takes a bit
to make these things work, but it's not too bad, just stick with it if it
doesn't work the first time you try (...and it won't).

http://www.cpearson.com/excel/Progress.htm

http://spreadsheetpage.com/index.php/site/tip/displaying_a_progress_indicator/


There is a way to have excel auto-calculate how long it will take. That
method is 'best practices' but harder. There is another way to 'force' the
progress bar to chug along, sort of like this:

Dim PB As clsProgBar
Set PB = New clsProgBar
With PB
..Title = "Progress Bar"
..Caption1 = "Executing, Please wait, this may take a short while..."
..Show
DoEvents

PB.Progress = 5
'some code here...
PB.Progress = 10
'more code here...
PB.Progress = 15
'even more code here...
PB.Progress = 20
'starting to get the idea???

PB.Progress = 100

This is a lot easier to set up, but not very eloquent.

 

[Peter T]

Seems way too long. There are probably ways to speed things up depending on
what you are doing.

If I follow, you want to hide any rows between 5:7818 if the entry in column
A is zero (or blank). If that's right try something like this

Sub HideZeroRows()
Dim rng As Range

On Error GoTo errExit
Application.ScreenUpdating = False
Columns("A:A").Insert

Set rng = Range("A5:A7818") ' <<< Change

rng.EntireRow.Hidden = False
rng.FormulaR1C1 = "=IF(RC[1]=0,1,"""")" ' =IF(B5=0,1,"")

On Error Resume Next
' get all formula cells in the temporary range that return a number
Set rng = rng.SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo errExit

If Not rng Is Nothing Then
rng.EntireRow.Hidden = True
End If

Columns("A:A").Delete

errExit:
Application.ScreenUpdating = True
End Sub

Regards,
Peter T