Progress

B

Basta1980

I've tried to use the 'progress indicator' to update on a peace of code.
Thing is, in the exercise (from J. Walkenbach) the Main procedure adds random
numbers. What I would like to do is whenever I activate commandbutton1 or
commandbutton2 (both buttons to be found in userform2) the progress inidcator
pops up. I however have no singel clue how to get about. I enclosed a copy of
my file.

Sheet TrimAll = where all the action happens
Sheet2 = Not used
Sheet3 = Not used

Userform1 pops up whenever you select the sheet. It asks the user if he/she
wants to delete HTML non-breaking spaces or not. If the user chooses to
delete the HTML non-breaking spaces Userform2 turns on. In this Userform (2)
the user can decide wether to adjust the whole package of data or just a
selection (using an inputbox). Now comes the tricky part (to me); in both
cases (so whenever a user chooses to adjust everything or just a selection)
I'd like to have a progress indicator displayed to them. Can you help me with
this (or just get me started)?!

I you need code referring to commandbutton 1 and 2, see below

Private Sub CommandButton1_Click()
Application.DisplayAlerts = True
Application.EnableEvents = True 'should be part of Change Event macro
If Application.Calculation = xlCalculationManual Then
MsgBox "Calculation was OFF will be turned ON upon completion"
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Select active content
Range("A2").CurrentRegion.Select
Dim cell As Range
'Also Treat CHR 0160, as a space (CHR 032)
Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Trim in Excel removes extra internal spaces, VBA does not
On Error Resume Next 'in case no text cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Value = Application.Trim(cell.Value)
Next cell
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton2_Click()
Dim rng As Range
On Error Resume Next
Specify = Application.InputBox _
(prompt:="Specify a range", Type:=8).Select
Dim cell As Range
'Also Treat CHR 0160, as a space (CHR 032)
Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Trim in Excel removes extra internal spaces, VBA does not
On Error Resume Next 'in case no text cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Value = Application.Trim(cell.Value)
Next cell
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton3_Click()
Unload UserForm2
End Sub

Private Sub UserForm_Click()

End Sub
 
J

Jim Cone

Something like...
CommandButton1_Click
Me.Hide
MyProgressBar.Show
Unload MyProgressBar
Me.Show
End Sub

In the module of the progress bar form...
UserForm_Activate()
Call MyCodeToTrimCellsAndIncrementProgressBar
End Sub
--
Jim Cone
Portland, Oregon USA




"Basta1980" <
(e-mail address removed)>
wrote in message
I've tried to use the 'progress indicator' to update on a peace of code.
Thing is, in the exercise (from J. Walkenbach) the Main procedure adds random
numbers. What I would like to do is whenever I activate commandbutton1 or
commandbutton2 (both buttons to be found in userform2) the progress inidcator
pops up. I however have no singel clue how to get about. I enclosed a copy of
my file.

Sheet TrimAll = where all the action happens
Sheet2 = Not used
Sheet3 = Not used

Userform1 pops up whenever you select the sheet. It asks the user if he/she
wants to delete HTML non-breaking spaces or not. If the user chooses to
delete the HTML non-breaking spaces Userform2 turns on. In this Userform (2)
the user can decide wether to adjust the whole package of data or just a
selection (using an inputbox). Now comes the tricky part (to me); in both
cases (so whenever a user chooses to adjust everything or just a selection)
I'd like to have a progress indicator displayed to them. Can you help me with
this (or just get me started)?!

I you need code referring to commandbutton 1 and 2, see below

Private Sub CommandButton1_Click()
Application.DisplayAlerts = True
Application.EnableEvents = True 'should be part of Change Event macro
If Application.Calculation = xlCalculationManual Then
MsgBox "Calculation was OFF will be turned ON upon completion"
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Select active content
Range("A2").CurrentRegion.Select
Dim cell As Range
'Also Treat CHR 0160, as a space (CHR 032)
Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Trim in Excel removes extra internal spaces, VBA does not
On Error Resume Next 'in case no text cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Value = Application.Trim(cell.Value)
Next cell
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton2_Click()
Dim rng As Range
On Error Resume Next
Specify = Application.InputBox _
(prompt:="Specify a range", Type:=8).Select
Dim cell As Range
'Also Treat CHR 0160, as a space (CHR 032)
Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Trim in Excel removes extra internal spaces, VBA does not
On Error Resume Next 'in case no text cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Value = Application.Trim(cell.Value)
Next cell
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton3_Click()
Unload UserForm2
End Sub
Sub
 
B

Basta1980

Jim,

Thanks so far. Due to your information i changed a bit in the code and yes
it did help. The only thing is, I don't see the progress indicator update (so
the sub Main() works and I see the progress indicator).

Option Explicit

Sub Start()
' The UserForm1_Activate sub calls Main
UserForm1.LabelProgress.Width = 0
UserForm1.Show
End Sub

Sub Main()
Range("A2").CurrentRegion.Select
Dim cell As Range
'Also Treat CHR 0160, as a space (CHR 032)
Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Trim in Excel removes extra internal spaces, VBA does not
On Error Resume Next 'in case no text cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Value = Application.Trim(cell.Value)
Next cell
Unload UserForm1
End Sub

Sub UpdateProgress(pct)
With UserForm1
.FrameProgress.Caption = Format(pct, "0%")
.LabelProgress.Width = pct * (.FrameProgress _
.Width - 10)
End With
' The DoEvents statement is responsible for the form updating
DoEvents
End Sub
 
J

Jim Cone

You are welcome so far.
You have to tell the progress bar how wide it should be...

Everything = TheDoughnut.Cells.Count
For Each Hole in TheDoughNut.Cells
'Take a bite
Bite = Bite + 1
AmountEaten = Bite/Everything
Call UpdateProgress(AmountEaten)
Next
--
Jim Cone
Portland, Oregon USA



"Basta1980"
<[email protected]>
wrote in message
Jim,
Thanks so far. Due to your information i changed a bit in the code and yes
it did help. The only thing is, I don't see the progress indicator update (so
the sub Main() works and I see the progress indicator).

Option Explicit
Sub Start()
' The UserForm1_Activate sub calls Main
UserForm1.LabelProgress.Width = 0
UserForm1.Show
End Sub

Sub Main()
Range("A2").CurrentRegion.Select
Dim cell As Range
'Also Treat CHR 0160, as a space (CHR 032)
Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Trim in Excel removes extra internal spaces, VBA does not
On Error Resume Next 'in case no text cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Value = Application.Trim(cell.Value)
Next cell
Unload UserForm1
End Sub

Sub UpdateProgress(pct)
With UserForm1
.FrameProgress.Caption = Format(pct, "0%")
.LabelProgress.Width = pct * (.FrameProgress _
.Width - 10)
End With
' The DoEvents statement is responsible for the form updating
DoEvents
End Sub
 
B

Basta1980

Jim,

I suppose

Everything = TheDoughnut.Cells.Count
For Each Hole in TheDoughNut.Cells
'Take a bite
Bite = Bite + 1
AmountEaten = Bite/Everything
Call UpdateProgress(AmountEaten)
Next

Comes in the sub Main()?!

Regards Bas
 
J

Jim Cone

'Add the following...
Set rng = Application.Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
NumCells = rng.Count

'Replace this...
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Value = Application.Trim(cell.Value)
Next cell

'With this...
For Each cell In rng.Cells
cell.Value = Application.Trim(cell.Value)
NumCount = NumCount + 1
Call UpdateProgress(NumCount/NumCells)
Next cell
--
Jim Cone
Portland, Oregon USA



"Basta1980"
<[email protected]>
wrote in message
Jim,
I suppose
Everything = TheDoughnut.Cells.Count
For Each Hole in TheDoughNut.Cells
'Take a bite
Bite = Bite + 1
AmountEaten = Bite/Everything
Call UpdateProgress(AmountEaten)
Next
Comes in the sub Main()?!
Regards Bas
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top