PDA

View Full Version : Status Bar or Progress Bar



Shums
07-26-2012, 04:01 AM
Hi All, I got this link http://spreadsheetpage.com/index.php/site/tip/displaying_a_progress_indicator/ which would work great, but now I don't know how to incorporate with below code:

Option Explicit
Public glb_origCalculationMode As Integer

Sub SpeedOn(Optional StatusBarMsg As String = "Running macro...")
glb_origCalculationMode = Application.Calculation
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Cursor = xlWait
.StatusBar = StatusBarMsg
.EnableCancelKey = xlErrorHandler
End With
End Sub

Sub SpeedOff()
With Application
.Calculation = glb_origCalculationMode
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.CalculateBeforeSave = True
.Cursor = xlDefault
.StatusBar = False
.EnableCancelKey = xlInterrupt
End With
End Sub
Sub GetMyData()
Dim pFolder As String, fileList As Variant, f As Variant
Dim cr As Long, cs As Worksheet, ws As Worksheet
Dim slaveWB As Workbook, slaveCols() As Variant, masterCols() As Variant
Dim i As Integer, lr As Long
Dim StatusBarMsg As String

On Error Goto TheEnd

StatusBarMsg = "Running macro..."

SpeedOn

'Set the parent folder of slave workbooks to process.
pFolder = "C:\Documents and Settings\Shums\Desktop\BSE\Desktop\Updation" & "\" '<-------- Change as needed.

' Set the column names for the slave and master workbooks with 1-1 match.
' Both arrays must have the same number of elements.
masterCols() = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
slaveCols() = Array("B", "C", "D", "E", "F", "G", "H", "U", "AJ", "AW", "BE", "BS")

'Add a new sheet and name it with today's date:
Set cs = Worksheets.Add(After:=ActiveSheet, Count:=1)
cs.Name = Format(Date, "dd-MMM-yy")

' Add header:
Range("A1").Value = "Sr. No."
Range("B1").Value = "Scrip Name"
Range("C1").Value = "Open"
Range("D1").Value = "High"
Range("E1").Value = "Low"
Range("F1").Value = "Close"
Range("G1").Value = "Volume"
Range("H1").Value = "Changes Value"
Range("I1").Value = "Changes %"
Range("J1").Value = "EMA13"
Range("K1").Value = "RSI"
Range("L1").Value = "Remarks"
Range("M1").Value = "SMA 200"
Range("N1").Value = "Ultimate Oscillator"
Range("A2").Select
ActiveWindow.FreezePanes = True

' Open each workbook except thisworkbook and get the data.
cr = 1
fileList = GetFileList(pFolder & "*.xl*")
For Each f In fileList
If ThisWorkbook.Name = f Then Goto Nextf

'Do your thing from here to Nextf.
Set slaveWB = Workbooks.Open(pFolder & f)
'change message in StatusBar to show curent workbook name
Application.StatusBar = StatusBarMsg
StatusBarMsg = "Processing....." & slaveWB.Name
'Add the data from slave to master.
For Each ws In slaveWB.Worksheets
cr = cr + 1
cs.Range("A" & cr).Value = cr - 1
cs.Range("B" & cr).Value = ws.Name
lr = ws.Range("A1").End(xlDown).Row
For i = LBound(slaveCols) To UBound(slaveCols)
cs.Range(masterCols(i) & cr).Value = ws.Range(slaveCols(i) & lr).Value
cs.Range(masterCols(i) & cr).NumberFormat = ws.Range(slaveCols(i) & lr).NumberFormat
Next i
Next ws
slaveWB.Close False
Nextf:
Next f

'Autofit the columns.
cs.UsedRange.Columns.AutoFit

TheEnd:
SpeedOff
End Sub


Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False

Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String

On Error Goto NoFilesFound

FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then Goto NoFilesFound

' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
Redim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function

' Error handler
NoFilesFound:
GetFileList = False
End Function

Or I would prefer something like this http://www.ozgrid.com/forum/attachment.php?attachmentid=47366&d=1343225369at the status bar.

Please help.....

Teeroy
07-26-2012, 05:38 AM
Hi Shums,

An easy change to what you are doing is append a "." to the statusbar message at each loop, rather than just the filename, and reset the message when you hit a length of 30 (chosen at random). This will distract the user as it is looks like a moving object :giggle .

The trickiest part of setting up the progress bar for me was getting the userform right (I hadn't used them much). I thought I had an example but it's embedded in a work project so if you want to pursue it let me know and I'll extract it. Here's another couple of easy to implement options that I came across that might help you https://groups.google.com/forum/?fromgroups#!topic/microsoft.public.excel.programming/sXubgTnFRCA.

Shums
07-26-2012, 11:52 AM
Thank You Teeroy for your concern.

I wish I can understand excel programming.

I found many threads for Progress Bar and Status bar and I am trying so hard to incorporate with mine, but shame I can't help myself. I really needs some experts help.

Tinbendr
07-26-2012, 02:04 PM
Please do this on a backup file.

Download the ProgInd.xls if you haven't already.

Open the workbook where you want the progress bar AND the progind file.

Open the VBA editor and DRAG the userform from progind to your workbook.

Change your code.

In the userform1 Activate event, change to Call GetMyData.

Create a Stump Sub.
Sub GetMyDataWithProgressBar
userform1.show
end sub

Sub GetMyData()
Dim pFolder As String, fileList As Variant, f As Variant
Dim cr As Long, cs As Worksheet, ws As Worksheet
Dim slaveWB As Workbook, slaveCols() As Variant, masterCols() As Variant
Dim i As Integer, lr As Long
Dim StatusBarMsg As String

On Error GoTo TheEnd

StatusBarMsg = "Running macro..."

SpeedOn

'Set the parent folder of slave workbooks to process.
pFolder = "C:\Documents and Settings\Shums\Desktop\BSE\Desktop\Updation" & "\" '<-------- Change as needed.

' Set the column names for the slave and master workbooks with 1-1 match.
' Both arrays must have the same number of elements.
masterCols() = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
slaveCols() = Array("B", "C", "D", "E", "F", "G", "H", "U", "AJ", "AW", "BE", "BS")

'Add a new sheet and name it with today's date:
Set cs = Worksheets.Add(After:=ActiveSheet, Count:=1)
cs.Name = Format(Date, "dd-MMM-yy")

' Add header:
Range("A1").Value = "Sr. No."
Range("B1").Value = "Scrip Name"
Range("C1").Value = "Open"
Range("D1").Value = "High"
Range("E1").Value = "Low"
Range("F1").Value = "Close"
Range("G1").Value = "Volume"
Range("H1").Value = "Changes Value"
Range("I1").Value = "Changes %"
Range("J1").Value = "EMA13"
Range("K1").Value = "RSI"
Range("L1").Value = "Remarks"
Range("M1").Value = "SMA 200"
Range("N1").Value = "Ultimate Oscillator"
Range("A2").Select
ActiveWindow.FreezePanes = True

' Open each workbook except thisworkbook and get the data.
cr = 1
fileList = GetFileList(pFolder & "*.xl*")

For Each f In fileList

Counter = Counter + 1
PctDone = Counter / UBound(fileList)
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

If ThisWorkbook.Name = f Then GoTo Nextf

'Do your thing from here to Nextf.
Set slaveWB = Workbooks.Open(pFolder & f)
'change message in StatusBar to show curent workbook name
Application.StatusBar = StatusBarMsg
StatusBarMsg = "Processing....." & slaveWB.Name
'Add the data from slave to master.
For Each ws In slaveWB.Worksheets
cr = cr + 1
cs.Range("A" & cr).Value = cr - 1
cs.Range("B" & cr).Value = ws.Name
lr = ws.Range("A1").End(xlDown).Row
For i = LBound(slaveCols) To UBound(slaveCols)
cs.Range(masterCols(i) & cr).Value = ws.Range(slaveCols(i) & lr).Value
cs.Range(masterCols(i) & cr).NumberFormat = ws.Range(slaveCols(i) & lr).NumberFormat
Next i
Next ws
slaveWB.Close False
Nextf:
Next f
Unload UserForm1
'Autofit the columns.
cs.UsedRange.Columns.AutoFit

TheEnd:
SpeedOff
End Sub

Shums
07-27-2012, 02:56 AM
Hi David,

Thanks a lot.

I added Dim Counter As Integer & Dim PctDone As Single in GetMyData Sub, and its working perfect. Thanks again.

Now my problem is its running very slow & secondly when it displays filename (slaveWB.name) in status bar, it delays two file names.

Tinbendr
07-27-2012, 03:52 AM
Now my problem is its running very slow & secondly when it displays filename (slaveWB.name) in status bar, it delays two file names.All normal for progress bars and statusbar.

The statusbar is more of a hit or miss situation. Most of the time, when I write to the statusbar on a large loop, it stops updating about 1/3 of the way through.

Shums
07-27-2012, 03:57 AM
Thanks again David.

Every day is learning.....

Kind Regards,
Shums

Kenneth Hobs
07-27-2012, 05:22 AM
In Speedon, comment out the Application.ScreenUpdating = False and see if that helps with the statusbar. Another DoEvents after Open might help.

For the statusbar, simply showing an integer percent of files processed might be easier on the eyes.

Microsoft's version of John Walkenbach's progressbar idea is at: http://support.microsoft.com/kb/211736

Where is the main article for the ozgrid graphic?

I had thought about using shapes to do progress meters but Andy Pope did that years ago: http://www.andypope.info/vba/pmeter.htm

Shums
07-27-2012, 06:49 AM
I am very grateful Mr. Kenneth to help me out.

I changed Application.ScreenUpdating = False & DoEvents after Open, still it takes 4mins, previously your code of GetMyData used to take hardly 2mins.

I did saw those links for Progress Bar and Status Bar, shame I am still not familiar with Excel terminology.

I don't have article for the Ozrid Graphic, I found Ivan's example for a graphical progress bar in the status bar here : http://www.xcelfiles.com/ProgressBar.html

As I said earlier "Now my problem is its running very slow & secondly when it displays filename (slaveWB.name) in status bar, it delays two file names". Can you please help me in this.

Shums
07-27-2012, 07:03 AM
Yesssss....I added SpeedOn in Stump Sub GetMyDataWithProgressBar and it worked perfectly like before, it just 1:30 mins to carry out this process.

Now just delay of slaveWB.name in status bar.

Tinbendr
07-27-2012, 09:37 AM
How does the progress bar represent the actual time? Is it fairly close?

You could add a userform label to the progress userform instead of writing to the statusbar.

Userform1.Label1.Caption = "Processing....." & slaveWB.Name

Shums
07-27-2012, 12:40 PM
Hi David,

Progress bar represent the actual time. Thanks to you...

I added new label in UserForm1 as ProcessProgress and edited below code, removed Status Bar option completely, but it does nothing now.

Sub GetMyData()
Dim pFolder As String, fileList As Variant, f As Variant
Dim cr As Long, cs As Worksheet, ws As Worksheet
Dim slaveWB As Workbook, slaveCols() As Variant, masterCols() As Variant
Dim i As Integer, lr As Long
Dim StatusBarMsg As String
Dim Counter As Integer
Dim PctDone As Single

On Error GoTo TheEnd

SpeedOn

StatusBarMsg = "Running macro..."

'Set the parent folder of slave workbooks to process.
pFolder = "C:\Documents and Settings\Shums\Desktop\BSE\Desktop\Updation" & "\" '<-------- Change as needed.

' Set the column names for the slave and master workbooks with 1-1 match.
' Both arrays must have the same number of elements.
masterCols() = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
slaveCols() = Array("B", "C", "D", "E", "F", "G", "H", "U", "AJ", "AW", "BE", "BS")

'Add a new sheet and name it with today's date:
Set cs = Worksheets.Add(After:=ActiveSheet, Count:=1)
cs.Name = Format(Date, "dd-MMM-yy")

' Add header:
Range("A1").Value = "Sr. No."
Range("B1").Value = "Scrip Name"
Range("C1").Value = "Open"
Range("D1").Value = "High"
Range("E1").Value = "Low"
Range("F1").Value = "Close"
Range("G1").Value = "Volume"
Range("H1").Value = "Changes Value"
Range("I1").Value = "Changes %"
Range("J1").Value = "EMA13"
Range("K1").Value = "RSI"
Range("L1").Value = "Remarks"
Range("M1").Value = "SMA 200"
Range("N1").Value = "Ultimate Oscillator"
Range("A2").Select
ActiveWindow.FreezePanes = True

' Open each workbook except thisworkbook and get the data.
cr = 1
fileList = GetFileList(pFolder & "*.xl*")

For Each f In fileList

Counter = Counter + 1
PctDone = Counter / UBound(fileList)
With UserForm1
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
.ProcessProgress.Caption = "Processing....." & slaveWB.Name
End With

If ThisWorkbook.Name = f Then GoTo Nextf

'Do your thing from here to Nextf.
Set slaveWB = Workbooks.Open(pFolder & f)

' The DoEvents statement is responsible for the form updating
DoEvents

'Add the data from slave to master.
For Each ws In slaveWB.Worksheets
cr = cr + 1
cs.Range("A" & cr).Value = cr - 1
cs.Range("B" & cr).Value = ws.Name
lr = ws.Range("A1").End(xlDown).Row
For i = LBound(slaveCols) To UBound(slaveCols)
cs.Range(masterCols(i) & cr).Value = ws.Range(slaveCols(i) & lr).Value
cs.Range(masterCols(i) & cr).NumberFormat = ws.Range(slaveCols(i) & lr).NumberFormat
Next i
Next ws
slaveWB.Close False
Nextf:
Next f
Unload UserForm1
'Autofit the columns.
cs.UsedRange.Columns.AutoFit

TheEnd:
SpeedOff
End Sub

Shums
07-27-2012, 12:57 PM
OK David,

Now I amended as below, its showing slaveWB.name in Progress Bar, but same it delays two file names.


Sub GetMyData()
Dim pFolder As String, fileList As Variant, f As Variant
Dim cr As Long, cs As Worksheet, ws As Worksheet
Dim slaveWB As Workbook, slaveCols() As Variant, masterCols() As Variant
Dim i As Integer, lr As Long
Dim StatusBarMsg As String
Dim Counter As Integer
Dim PctDone As Single

On Error GoTo TheEnd

StatusBarMsg = "Running macro..."

SpeedOn

'Set the parent folder of slave workbooks to process.
pFolder = "C:\Documents and Settings\Shums\Desktop\BSE\Desktop\Updation" & "\" '<-------- Change as needed.

' Set the column names for the slave and master workbooks with 1-1 match.
' Both arrays must have the same number of elements.
masterCols() = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
slaveCols() = Array("B", "C", "D", "E", "F", "G", "H", "U", "AJ", "AW", "BE", "BS")

'Add a new sheet and name it with today's date:
Set cs = Worksheets.Add(After:=ActiveSheet, Count:=1)
cs.Name = Format(Date, "dd-MMM-yy")

' Add header:
Range("A1").Value = "Sr. No."
Range("B1").Value = "Scrip Name"
Range("C1").Value = "Open"
Range("D1").Value = "High"
Range("E1").Value = "Low"
Range("F1").Value = "Close"
Range("G1").Value = "Volume"
Range("H1").Value = "Changes Value"
Range("I1").Value = "Changes %"
Range("J1").Value = "EMA13"
Range("K1").Value = "RSI"
Range("L1").Value = "Remarks"
Range("M1").Value = "SMA 200"
Range("N1").Value = "Ultimate Oscillator"
Range("A2").Select
ActiveWindow.FreezePanes = True

' Open each workbook except thisworkbook and get the data.
cr = 1
fileList = GetFileList(pFolder & "*.xl*")

For Each f In fileList

Counter = Counter + 1
PctDone = Counter / UBound(fileList)
With UserForm1
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With

If ThisWorkbook.Name = f Then GoTo Nextf

'Do your thing from here to Nextf.
Set slaveWB = Workbooks.Open(pFolder & f)
' The DoEvents statement is responsible for the form updating
DoEvents
'Add message in UserForm1 to show curent workbook name
UserForm1.ProcessProgress.Caption = "Processing....." & slaveWB.Name
'Add the data from slave to master.
For Each ws In slaveWB.Worksheets
cr = cr + 1
cs.Range("A" & cr).Value = cr - 1
cs.Range("B" & cr).Value = ws.Name
lr = ws.Range("A1").End(xlDown).Row
For i = LBound(slaveCols) To UBound(slaveCols)
cs.Range(masterCols(i) & cr).Value = ws.Range(slaveCols(i) & lr).Value
cs.Range(masterCols(i) & cr).NumberFormat = ws.Range(slaveCols(i) & lr).NumberFormat
Next i
Next ws
slaveWB.Close False
Nextf:
Next f
Unload UserForm1
'Autofit the columns.
cs.UsedRange.Columns.AutoFit

TheEnd:
SpeedOff
End Sub

Tinbendr
07-27-2012, 01:54 PM
It's interesting that it has been two behind the whole process.

I have no clue, but you might try and rearrange this section.

If ThisWorkbook.Name = f Then Goto Nextf
'Add message in UserForm1 to show curent workbook name
UserForm1.ProcessProgress.Caption = "Processing....." & slaveWB.Name
' The DoEvents statement is responsible for the form updating
DoEvents
'Do your thing from here to Nextf.
Set slaveWB = Workbooks.Open(pFolder & f)

Shums
07-27-2012, 02:53 PM
Hi David,

It was not excepting slaveWB.Name before Set slaveWB = Workbooks.Open(pFolder & f) so I changed as
If ThisWorkbook.Name = f Then Goto Nextf
'Do your thing from here to Nextf.
Set slaveWB = Workbooks.Open(pFolder & f)
'Add message in UserForm1 to show curent workbook name
UserForm1.ProcessProgress.Caption = "Processing....." & slaveWB.Name
' The DoEvents statement is responsible for the form updating
DoEvents

Now its just one file name delay :)

Tinbendr
07-27-2012, 03:11 PM
It was not excepting slaveWB.Name before :doh: Of course, sorry.

Teeroy
07-28-2012, 04:06 AM
The lag is a bit strange. What exactly is indicating that there is a lag?

Also you could probably change

UserForm1.ProcessProgress.Caption = "Processing....." & slaveWB.Name

to

UserForm1.ProcessProgress.Caption = "Processing....." & f

You might get a small speed saving not accessing the workbook object all the time.

Shums
07-29-2012, 07:38 AM
Thanks Teeroy,

I did still the same. I would like show time remaining to complete this process, anyone pls help?

I have found this link....http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/A_1756-A-VBA-Progress-Bar-for-Excel-and-Other-Microsoft-Apps.html
again I am failing to incorporate with my coding...

Please see if you can do something with this ProgressBar?

Shums
07-29-2012, 09:35 AM
Hi All,

Below is my final code, still its now showing time remaining in progress bar, please help:
Sub GetMyData()
Dim pFolder As String, fileList As Variant, f As Variant
Dim cr As Long, cs As Worksheet, ws As Worksheet
Dim slaveWB As Workbook, slaveCols() As Variant, masterCols() As Variant
Dim i As Integer, lr As Long
Dim StatusBarMsg As String
Dim Counter As Integer
Dim PctDone As Single
Dim StartTime As Double

On Error GoTo TheEnd
SpeedOn

'Set the parent folder of slave workbooks to process.
pFolder = "C:\Documents and Settings\Shums\Desktop\BSE\Desktop\Updation" & "\" '<-------- Change as needed.

' Set the column names for the slave and master workbooks with 1-1 match.
' Both arrays must have the same number of elements.
masterCols() = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
slaveCols() = Array("B", "C", "D", "E", "F", "G", "H", "U", "AJ", "AW", "BE", "BS")

'Add a new sheet and name it with today's date:
Set cs = Worksheets.Add(After:=ActiveSheet, Count:=1)
cs.Name = Format(Date, "dd-MMM-yy")

' Add header:
Range("A1").Value = "Sr. No."
Range("B1").Value = "Scrip Name"
Range("C1").Value = "Open"
Range("D1").Value = "High"
Range("E1").Value = "Low"
Range("F1").Value = "Close"
Range("G1").Value = "Volume"
Range("H1").Value = "Changes Value"
Range("I1").Value = "Changes %"
Range("J1").Value = "EMA13"
Range("K1").Value = "RSI"
Range("L1").Value = "Remarks"
Range("M1").Value = "SMA 200"
Range("N1").Value = "Ultimate Oscillator"
Range("A2").Select
ActiveWindow.FreezePanes = True

' Open each workbook except thisworkbook and get the data.
cr = 1
fileList = GetFileList(pFolder & "*.xl*")
For Each f In fileList

StartTime = Time()
Counter = Counter + 1
PctDone = Counter / UBound(fileList)
With StockPick
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
.RemainingTime.Caption = "Estimated Time Remaining....." & Format(((StartTime + ((Time() - StartTime) / Counter) * PctDone) - Time()), "mm:ss")
End With

If ThisWorkbook.Name = f Then GoTo Nextf

'Do your thing from here to Nextf.
Set slaveWB = Workbooks.Open(pFolder & f)

'Add message in StockPick to show curent workbook name
StockPick.ProcessProgress.Caption = "Processing....." & f

' The DoEvents statement is responsible for the form updating
DoEvents

'Add the data from slave to master.
For Each ws In slaveWB.Worksheets
cr = cr + 1
cs.Range("A" & cr).Value = cr - 1
cs.Range("B" & cr).Value = ws.Name
lr = ws.Range("A1").End(xlDown).Row
For i = LBound(slaveCols) To UBound(slaveCols)
cs.Range(masterCols(i) & cr).Value = ws.Range(slaveCols(i) & lr).Value
cs.Range(masterCols(i) & cr).NumberFormat = ws.Range(slaveCols(i) & lr).NumberFormat
Next i
Next ws
slaveWB.Close False
Nextf:
Next f
Unload StockPick
Application.ScreenUpdating = True

'Autofit the columns.
cs.UsedRange.Columns.AutoFit

TheEnd:
SpeedOff
End Sub
Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False

Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String

On Error GoTo NoFilesFound

FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound

' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function

' Error handler
NoFilesFound:
GetFileList = False
End Function

Teeroy
07-29-2012, 02:34 PM
What problem do you have with the time remaining? Not displayed or incorrect?

I think your math is wrong for the estimation. Try the following

.RemainingTime.Caption = "Estimated Time Remaining....." & Format((StartTime + (Time() - StartTime) / PctDone) , "mm:ss")

Shums
07-30-2012, 12:30 PM
Hi Teeroy,

Thanks for correction. It still displays incorrect time.

Kenneth Hobs
07-30-2012, 02:35 PM
Even if the Excel files are exactly the same one, the times to open will vary. I guess you can do some sample runs to find an average and use that in your computations.

Teeroy
08-01-2012, 02:55 AM
Your code is essentially doing what Kenneth suggests and averaging the times of runs taken to date and extrapolating forward. If you are running a small sample though including the file you skip (ThisWorkbook) as a processed file in the forecast could warp the results. You might improve the accuracy with the following which will exclude ThisWorkbook from the count and forecast.

Sub GetMyData()
Dim pFolder As String, fileList As Variant, f As Variant
Dim cr As Long, cs As Worksheet, ws As Worksheet
Dim slaveWB As Workbook, slaveCols() As Variant, masterCols() As Variant
Dim i As Integer, lr As Long
Dim StatusBarMsg As String
Dim Counter As Integer
Dim PctDone As Single

On Error Goto TheEnd

StatusBarMsg = "Running macro..."

SpeedOn

'Set the parent folder of slave workbooks to process.
pFolder = "C:\Documents and Settings\Shums\Desktop\BSE\Desktop\Updation" & "\" '<-------- Change as needed.

' Set the column names for the slave and master workbooks with 1-1 match.
' Both arrays must have the same number of elements.
masterCols() = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
slaveCols() = Array("B", "C", "D", "E", "F", "G", "H", "U", "AJ", "AW", "BE", "BS")

'Add a new sheet and name it with today's date:
Set cs = Worksheets.Add(After:=ActiveSheet, Count:=1)
cs.Name = Format(Date, "dd-MMM-yy")

' Add header:
Range("A1").Value = "Sr. No."
Range("B1").Value = "Scrip Name"
Range("C1").Value = "Open"
Range("D1").Value = "High"
Range("E1").Value = "Low"
Range("F1").Value = "Close"
Range("G1").Value = "Volume"
Range("H1").Value = "Changes Value"
Range("I1").Value = "Changes %"
Range("J1").Value = "EMA13"
Range("K1").Value = "RSI"
Range("L1").Value = "Remarks"
Range("M1").Value = "SMA 200"
Range("N1").Value = "Ultimate Oscillator"
Range("A2").Select
ActiveWindow.FreezePanes = True

' Open each workbook except thisworkbook and get the data.
cr = 1
fileList = GetFileList(pFolder & "*.xl*")

For Each f In fileList

Counter = Counter + 1
PctDone = Counter / (UBound(fileList) - 1)
With UserForm1
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With

If ThisWorkbook.Name = f Then
Counter = Counter - 1
Goto Nextf
end if

'Do your thing from here to Nextf.
Set slaveWB = Workbooks.Open(pFolder & f)
' The DoEvents statement is responsible for the form updating
DoEvents
'Add message in UserForm1 to show curent workbook name
UserForm1.ProcessProgress.Caption = "Processing....." & slaveWB.Name
'Add the data from slave to master.
For Each ws In slaveWB.Worksheets
cr = cr + 1
cs.Range("A" & cr).Value = cr - 1
cs.Range("B" & cr).Value = ws.Name
lr = ws.Range("A1").End(xlDown).Row
For i = LBound(slaveCols) To UBound(slaveCols)
cs.Range(masterCols(i) & cr).Value = ws.Range(slaveCols(i) & lr).Value
cs.Range(masterCols(i) & cr).NumberFormat = ws.Range(slaveCols(i) & lr).NumberFormat
Next i
Next ws
slaveWB.Close False
Nextf:
Next f
Unload UserForm1
'Autofit the columns.
cs.UsedRange.Columns.AutoFit

TheEnd:
SpeedOff
End Sub

Shums
08-01-2012, 03:53 AM
Thank You Teeroy,

It improved the accuracy, when its closing files of slaveWB, ProgressBar displays its name as its closed. Now I would request you all to please help me in getting time elapsed and time remaining captions on userform1.

Thanking you in advance.

Teeroy
08-01-2012, 05:03 AM
Try moving "DoEvents" immediately before "For Each ws In slaveWB.Worksheets". The "UserForm1.ProcessProgress.Caption = ..." isn't being updated until the next file loop.

Shums
08-01-2012, 06:10 AM
Hi Terroy,

Below is my code after correction, still the same, ProgressBar displays filename after getfilelist closes its process.

Sub GetMyData()
Dim pFolder As String, fileList As Variant, f As Variant
Dim cr As Long, cs As Worksheet, ws As Worksheet
Dim slaveWB As Workbook, slaveCols() As Variant, masterCols() As Variant
Dim i As Integer, lr As Long
Dim StatusBarMsg As String
Dim Counter As Integer
Dim PctDone As Single

On Error GoTo TheEnd
SpeedOn

'Set the parent folder of slave workbooks to process.
pFolder = "C:\Documents and Settings\Shums\Desktop\BSE\Desktop\Updation" & "\" '<-------- Change as needed.

' Set the column names for the slave and master workbooks with 1-1 match.
' Both arrays must have the same number of elements.
masterCols() = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
slaveCols() = Array("B", "C", "D", "E", "F", "G", "H", "U", "AJ", "AW", "BE", "BS")

'Add a new sheet and name it with today's date:
Set cs = Worksheets.Add(After:=ActiveSheet, Count:=1)
cs.Name = Format(Date, "dd-MMM-yy")

' Add header:
Range("A1").Value = "Sr. No."
Range("B1").Value = "Scrip Name"
Range("C1").Value = "Open"
Range("D1").Value = "High"
Range("E1").Value = "Low"
Range("F1").Value = "Close"
Range("G1").Value = "Volume"
Range("H1").Value = "Changes Value"
Range("I1").Value = "Changes %"
Range("J1").Value = "EMA13"
Range("K1").Value = "RSI"
Range("L1").Value = "Remarks"
Range("M1").Value = "SMA 200"
Range("N1").Value = "Ultimate Oscillator"
Range("A2").Select
ActiveWindow.FreezePanes = True

' Open each workbook except thisworkbook and get the data.
cr = 1
fileList = GetFileList(pFolder & "*.xl*")
For Each f In fileList

Counter = Counter + 1
PctDone = Counter / UBound(fileList)
With StockPick
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With

If ThisWorkbook.Name = f Then
Counter = Counter - 1
GoTo Nextf
End If

If ThisWorkbook.Name = f Then GoTo Nextf

'Do your thing from here to Nextf.
Set slaveWB = Workbooks.Open(pFolder & f)

'Add message in StockPick to show curent workbook name
StockPick.ProcessProgress.Caption = "Processing....." & f

' The DoEvents statement is responsible for the form updating
DoEvents

'Add the data from slave to master.
For Each ws In slaveWB.Worksheets
cr = cr + 1
cs.Range("A" & cr).Value = cr - 1
cs.Range("B" & cr).Value = ws.Name
lr = ws.Range("A1").End(xlDown).Row
For i = LBound(slaveCols) To UBound(slaveCols)
cs.Range(masterCols(i) & cr).Value = ws.Range(slaveCols(i) & lr).Value
cs.Range(masterCols(i) & cr).NumberFormat = ws.Range(slaveCols(i) & lr).NumberFormat
Next i
'Add message in StockPick to show curent workbook name
StockPick.ProcessProgress.Caption = f & " " & "It's Been Updated....."

Next ws
slaveWB.Close False
Nextf:
Next f
Unload StockPick
Application.ScreenUpdating = True

'Autofit the columns.
cs.UsedRange.Columns.AutoFit

TheEnd:
SpeedOff
End Sub
Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False

Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String

On Error GoTo NoFilesFound

FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound

' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function

' Error handler
NoFilesFound:
GetFileList = False
End Function

Teeroy
08-01-2012, 03:05 PM
I think I see what's happened...
StockPick.ProcessProgress.Caption = f & " " & "It's Been Updated....." will never display (until speedoff). You've got nothing updating the form until the next file loop and you've overwritten the caption by then to display the next filename. If you really want to display what has already been processed add a separate label to the progressbar userform and display it there.

Also you can remove "If ThisWorkbook.Name = f Then Goto Nextf " as it's handled by the if block above it.