markster
Well-known Member
- Joined
- May 23, 2002
- Messages
- 579
- Office Version
- 365
- Platform
- Windows
- 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
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