Help with Example VBA code for making progress bar

markster

Well-known Member
Joined
May 23, 2002
Messages
579
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
I'm trying to adapt a progress bar to meet my own needs. The article I have been referring to as follows:

http://j-walk.com/ss/excel/tips/tip34.htm

I've created the Userform,Labels etc etc but am having trouble adapting the following code which is the main Subroutine:

Sub Main()
' Inserts random numbers on the active worksheet
Dim Counter As Integer
Dim RowMax As Integer, ColMax As Integer
Dim r As Integer, c As Integer
Dim PctDone As Single

If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
Cells.Clear
Application.ScreenUpdating = False
Counter = 1
RowMax = 100
ColMax = 25
For r = 1 To RowMax
For c = 1 To ColMax
Cells(r, c) = Int(Rnd * 1000)
Counter = Counter + 1
Next c
PctDone = Counter / (RowMax * ColMax)
With UserForm1
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With
' The DoEvents statement is responsible for the form updating
DoEvents
Next r
Unload UserForm1
End Sub

The above is to create random numbers but knowing the minimal amount of VBA I was hoping remove the bit that creates the random numbers and replace with my own main code (see below). The problem is I can't tell which bits of this code I need to remove to do this and which bits to keep. The instructions seem a bit wooly to me and are aimed I suppose at developers who know what they are doing.
It says:

The Main subroutine is listed below. This demo routine simply inserts random numbers into the active worksheet. As it does so, it changes the width of the Label control and displays the percent completed in the Frame's caption. You will, of course, substitute your own subroutine. And you'll need to figure out how to determine the progress complete.

My questions how do I take the bit that generates the random numbers out and how do I figure out how to determine the progress complete and when I do what bit of the code I'm supposed to change to what!
The code I want to insert is:

Sub GrantVariationFormat()

For MY_ROWS = Range("C65536").End(xlUp).Row To 1 Step -1
If IsEmpty(Range("C" & MY_ROWS)) Then
Rows(MY_ROWS).Delete
End If
Next MY_ROWS
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=4
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit
Columns("K:K").EntireColumn.AutoFit
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1))
ActiveCell.FormulaR1C1 = ""
Range("A1").Select
ActiveCell.FormulaR1C1 = "Count"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Init"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Yr"
Range("D1").Select
ActiveCell.FormulaR1C1 = "No"
Columns("A:D").Select
Selection.ColumnWidth = 5
Columns("A:D").Select
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Columns("F:F").Select
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Columns("K:K").Select
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Columns("M:N").Select
With Selection
.HorizontalAlignment = xlRight
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
For MY_ROWS = Range("B65536").End(xlUp).Row To 1 Step -1
If Range("B" & MY_ROWS).Value <> "Init" And Range("B" & MY_ROWS).Value <> "OSL" And Range("B" & MY_ROWS).Value <> "OSS" And _
Range("B" & MY_ROWS).Value <> "SCO" And Range("B" & MY_ROWS).Value <> "EXT" And Range("B" & MY_ROWS).Value <> "CLL" Or _
IsEmpty(Range("F" & MY_ROWS)) Then
Rows(MY_ROWS).Delete
End If
Next MY_ROWS
Range("O1").Select
ActiveCell.FormulaR1C1 = "Adjustment"
Range("O2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Range("O2").Select

Range("P1").Select
ActiveCell.FormulaR1C1 = "Month"
Range("P2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[-5])&TEXT(RC[-5],""mmm"")"

Range("Q1").Select
ActiveCell.FormulaR1C1 = "Quarter"
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=TEXT(EOMONTH(DATE(YEAR(RC[-6]),MROUND(MONTH(RC[-6])+1,3)+1,1)-1,-3)+1,""yyyy-mm-dd"") & "" - "" & TEXT(DATE(YEAR(RC[-6]),MROUND(MONTH(RC[-6])+1,3)+1,1)-1,""yyyy-mm-dd"")"

Range("R1").Select
ActiveCell.FormulaR1C1 = "Variation Type"
Range("R2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-6]=""Update Awarded Amounts"",""Financial Variation"",IF(RC[-6]=""Terminate Grant"",""Financial Variation"",""Non Financial Variation""))"

Range("O2:R2").Select
Selection.AutoFill Destination:=Range("O2:R65536"), Type:=xlFillDefault
Range("O2:R65536").Select

Columns("O:R").Select
Columns("O:R").EntireColumn.AutoFit
Range("O1:R1").Select
Selection.Font.Bold = True
Columns("M:O").Select
Selection.NumberFormat = "#,##0"

End Sub

All the other code is in place it's just this main bit. I've been trying for the last hour and a half and just can't get it to work.

Can anyone help or should I just give up and try to get on a VBA course (which I am trying to do by the way).
Thanks
Markster
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Forum statistics

Threads
1,214,833
Messages
6,121,864
Members
449,052
Latest member
Fuddy_Duddy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top