Status Bar or Progress Bar

S

Shums

New Member
Joined
Jul 24, 2011
Messages
18
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:

Code: 
[/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Option Explicit[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Public[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] glb_origCalculationMode [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Integer[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]  [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Sub[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] SpeedOn(Optional StatusBarMsg [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]String[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] = "Running macro...")     glb_origCalculationMode = Application.Calculation     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]With[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] Application         .Calculation = xlCalculationManual         .ScreenUpdating = [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]False[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]         .EnableEvents = [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]False[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]         .DisplayAlerts = [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]False[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]         .Cursor = xlWait         .StatusBar = StatusBarMsg         .EnableCancelKey = xlErrorHandler     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]End With[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]End Sub[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]  [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Sub[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] SpeedOff()     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]With[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] Application         .Calculation = glb_origCalculationMode         .ScreenUpdating = [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]True[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]         .EnableEvents = [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]True[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]         .DisplayAlerts = [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]True[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]         .CalculateBeforeSave = [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]True[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]         .Cursor = xlDefault         .StatusBar = [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]False[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]         .EnableCancelKey = xlInterrupt     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]End With[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]End Sub[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Sub[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] GetMyData()     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Dim[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] pFolder [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]String[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace], fileList [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Variant[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace], f [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Variant[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Dim[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] cr [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Long[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace], cs [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] Worksheet, ws [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] Worksheet     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Dim[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] slaveWB [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] Workbook, slaveCols() [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Variant[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace], masterCols() [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Variant[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Dim[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] i [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Integer[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace], lr [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Long[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Dim[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] StatusBarMsg [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]String[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]          [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]On Error Goto[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] TheEnd          StatusBarMsg = "Running macro..."          SpeedOn           [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]'Set the parent folder of slave workbooks to process.[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]    pFolder = "C:\Documents and Settings\Shums\Desktop\BSE\Desktop\Updation" & "\" [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]'<-------- Change as needed.[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]          [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]' Set the column names for the slave and master workbooks with 1-1 match.[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]     [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]' Both arrays must have the same number of elements.[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]    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")           [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]'Add a new sheet and name it with today's date:[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]    [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Set[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] cs = Worksheets.Add(After:=ActiveSheet, Count:=1)     cs.Name = Format(Date, "dd-MMM-yy")           [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]' Add header:[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]    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 = [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]True[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]           [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]' Open each workbook except thisworkbook and get the data.[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]    cr = 1     fileList = GetFileList(pFolder & "*.xl*")     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]For Each[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] f [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]In[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] fileList         [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]If[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] ThisWorkbook.Name = f [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Then[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Goto[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] Nextf                   [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]'Do your thing from here to Nextf.[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]        [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Set[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] slaveWB = Workbooks.Open(pFolder & f)          [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]'change message in StatusBar to show curent workbook name[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]        Application.StatusBar = StatusBarMsg         StatusBarMsg = "Processing....." & slaveWB.Name          [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]'Add the data from slave to master.[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]        [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]For Each[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] ws [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]In[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] 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             [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]For[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] i = [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]LBound[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace](slaveCols) [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]To[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]UBound[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace](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             [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Next[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] i         [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Next[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] ws         slaveWB.Close [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]False[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] Nextf:     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Next[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] f           [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]'Autofit the columns.[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]    cs.UsedRange.Columns.AutoFit      TheEnd:     SpeedOff [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]End Sub[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]   [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Function[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] GetFileList(FileSpec [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]String[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]) [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Variant[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]      [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]'   Returns an array of filenames that match FileSpec[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]     [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]'   If no matching files are found, it returns False[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]         [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Dim[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] FileArray() [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Variant[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Dim[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] FileCount [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Integer[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Dim[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] FileName [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]As[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]String[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]          [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]On Error Goto[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] NoFilesFound          FileCount = 0     FileName = Dir(FileSpec)     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]If[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] FileName = "" [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Then[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Goto[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] NoFilesFound           [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]'   Loop until no more matching files are found[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]    [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Do[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]While[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] FileName <> ""         FileCount = FileCount + 1         Redim Preserve FileArray(1 [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]To[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] FileCount)         FileArray(FileCount) = FileName         FileName = Dir()     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Loop[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]     GetFileList = FileArray     [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]Exit Function[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]           [/FONT][/COLOR][/LEFT][COLOR=darkgreen][LEFT][FONT=monospace]'   Error handler[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace]NoFilesFound:     GetFileList = [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]False[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][/LEFT][COLOR=blue][LEFT][FONT=monospace]End Function[/FONT][/LEFT][/COLOR][LEFT][COLOR=#000000][FONT=monospace] [/FONT][/COLOR][COLOR=#000000][FONT=verdana]

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

Please help.....


​
 
Sort by date Sort by votes
Hi, not sure what your question is, have you tried following the instructions stated on the page you posted?
You had the possibility to download a copy for your perusal.
Link to said file.
 
Upvote 0
Hi Cyrilbrd,

Thanks for your response, I did downloaded said file. Imported UserForm, but I am failing to incorporate with my VBA.
 
Upvote 0
Try posting your code again. It's a bit of a jumbled mess when I try and copy it.

I've been having similar problems posting code examples myself every now and then.

Dom
 
Upvote 0
I did pasted in code, but I don't know why it didn't show full version....Hope this work

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
 
Upvote 0
Your code is different, I failed to see this, sadly the new forum's code aren't displayed in full (wonder why).
Hopefully Domski will be able to assit you.

Cheers.
 
Upvote 0
The example on the web site is a loop that drives the progress bar:

Code: 
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

If you want one you need to incorporate something into your code that determins the progress that has been made and refreshes the form accordingly. You might be better off just updating the status bar at various points throughout the code execution. It's not as pretty as a progress bar but it's a lot easier.

Dom
 
Upvote 0
Dom,

I didn't understand your last message? You mean, I must not opt for ProgressBar & get something better for Status Bar?

I do agree, check this
attachment.php
image, If I could get something like this. And I do agree Progress Bar slows down your VBA.
 
Upvote 0
You can use a progress bar if you want but you would need to work something into your code to progress it as it executes. The sample code provided with it is a loop that redraws the form with the progress updated each time it increments.

I can't see your image to not sure what you are referring to.

Dom
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Macro to extract .msg subject and date into excel
Replies
1
Views
2K
agouveia
A
I
  • Question Question
Wait command for slow printer?
Replies
0
Views
375
iliauk
I
E
  • Question Question
Macro won't work
Replies
8
Views
2K
exandbeyond
E
K
  • Question Question
Use VBA to get Full File Path
Replies
2
Views
6K
KK0319
K
D
  • Question Question
Progress in Status Bar For Macro That Loops Through All Excel Files in a Folder
2
Replies
10
Views
5K
AlphaFrog
AlphaFrog

Share this page

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