Status Bar

Shums · Jul 22nd 2012

Hi All,

I have VBA which extracts data from specific folder which has 20 workbooks, opening them in background and displays "Running macro..." in status bar, I would like to know at what file its up to Or is there any way to show file name or sheet name with "Running macro...." and how much % to finish this macro in status bar?

Richie(UK) · Jul 22nd 2012

Re: Status Bar

Hi and welcome to the firum.

You could amend something like this to suit your purposes.

Code

Sub SBProgInd()
    Dim Count As Long, Iterations As Integer, progress As Integer
    
    Iterations = 10000
    
    For Count = 1 To Iterations
        Sheet1.Range("A20").Value = Count
        progress = Count * 100 / Iterations
        Application.StatusBar = progress & "% complete"
    Next Count


End Sub

Display More

Shums · Jul 22nd 2012

Re: Status Bar

Thanks Richie,

It is calculating % at the beginning, then runs my other macros by showing just "Running Macro..." in status bar.

**royUK** · Jul 22nd 2012

Re: Status Bar

Post your code

Shums · Jul 22nd 2012

Re: Status Bar

This is just one vba code, I have 6 more vba in this workbook:

Code

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
    
    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"
        
    ' 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)
         
         '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

Display More

Shums · Jul 22nd 2012

Re: Status Bar

Here is another one which says "Running Macro..." in the status bar.

Code

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

Display More

**royUK** · Jul 23rd 2012

Re: Status Bar

I think this will do what you want

Code

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..."


    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .Cursor = xlWait
        .StatusBar = StatusBarMsg
        .EnableCancelKey = xlErrorHandler


        '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"


        ' 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)


            'Add the data from slave to master.
            For Each ws In slaveWB.Worksheets
            'change message in StatusBar to show curent workbook name
                StatusBarMsg = "Processing " & ws.Name
                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:
        .Calculation = glb_origCalculationMode
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .CalculateBeforeSave = True
        .Cursor = xlDefault
        .StatusBar = False
        .EnableCancelKey = xlInterrupt
    End With
End Sub

Display More

Shums · Jul 24th 2012

Re: Status Bar

Thank You Mr. Roy & sorry for late reply.

It doesn't change from "Running Macro..." to "Processing " & ws.name. Secondly its running very slow and thirdly it stops at .Calculation = glb_origCalculationMode

I need to know what file (slaveWB) its running not the ws.name, so I changed it to "Processing " & slaveWB.Name, but no result...

Please help.

**royUK** · Jul 24th 2012

Re: Status Bar

Maybe

Code

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..."


    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .Cursor = xlWait
        .StatusBar = StatusBarMsg
        .EnableCancelKey = xlErrorHandler


        '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"


        ' 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
            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:
        .Calculation = glb_origCalculationMode
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .CalculateBeforeSave = True
        .Cursor = xlDefault
        .StatusBar = False
        .EnableCancelKey = xlInterrupt
    End With
End Sub

Display More

Shums · Jul 24th 2012

Re: Status Bar

Thank You Mr. Roy & sorry for late reply.

It doesn't change from "Running Macro..." to "Processing " & ws.name. Secondly its running very slow and thirdly it stops at .Calculation = glb_origCalculationMode

Please help.

Richie(UK) · Jul 24th 2012

Re: Status Bar

Hi,

You need to actually tell the status bar to display the message. Add the following line after the part where the StatusBarMsg variable is updated.

Code

Application.StatusBar = StatusBarMsg

Shums · Jul 24th 2012

Re: Status Bar

Roy,

Still the same. It doesn't change from Running Macro to Processing. Eventually it comes out with the result but pops up error 1004 for .Calculation = glb_origCalculationMode and pointer shows busy.

Shums · Jul 24th 2012

Re: Status Bar

Wow Richie,

It worked, it started showing file names at the status bar with "Processing....", but I feel its bit late somewhat two files to display its name.

Secondly as I mentioned earlier at the end it pops up error 1004 for .Calculation = glb_origCalculationMode and pointer shows busy.

Thirdly I would like to show percentage of complete too.

Please help....

Richie(UK) · Jul 25th 2012

Re: Status Bar

Where is the variable glb_origCalculationMode declared? How/when is it given a value?

If you want a percentage figure you will need to know how many files are being processed. I assume that you have a function called GetFileList that is used to populate the fileList Variant variable. Have a look at the Ubound property and use that in combination with my original post (#2) to see if you can figure it out.

Shums · Jul 25th 2012

Re: Status Bar

Richie thanks for your response, but I am not VBA expert, I am just a beginner.

glb_origCalculationMode is solved, I started with Open Explcit.

Now my concern is why it displays filename bit late?

I have 20 files in that slave folder where GetFileList function is called, but their property differs, some workbook has 10 worksheet and some 20 worksheet.

Could you please response with the code?

Shums · Jul 25th 2012

Re: Status Bar

Hi All, I found Ivan's example for a graphical progress bar in the statusbar.
[ATTACH=CONFIG]47366[/ATTACH]
I would love to have such bar, see if anyone can help.

Shums · Jul 25th 2012

Re: Status Bar

Hi All,

I got this link which would work great, but now I don't know how to consolidate with below code:

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

Display More

Please help

Shums · Jul 25th 2012

Re: Status Bar

Ooops forgot to add link http://spreadsheetpage.com/ind…ing_a_progress_indicator/

Richie(UK) · Jul 25th 2012

Re: Status Bar

Quote from Shums;620117

Richie thanks for your response, but I am not VBA expert, I am just a beginner. ...

In that case I would offer two bits of advice (just my opinion - you may see it differently):
1. Don't blindly copy bits of code from multiple sources and then put it all together and expect it to work. Try to understand how the code works and how it can be used to achieve your objective.
2. If you want to progress from being a beginner you need to try to improve. It doesn't matter if you don't get it right first time - we often learn by our mistakes - but if somebody points you in the right direction you should at least give it a go.

Shums · Jul 26th 2012

Re: Status Bar

Sorry Richie,

If any of my reply offended you. I am trying to understand logically how the code works, but I am not aware of exact Excel terminology to incorporate with existing code. If I would be able to write VBA code, I would have not posted my query here. And I am sure, many members here posting their query or asking experts their advice are not aware of VBA coding.

Thanks for your advice, I will take care next time.

Status Bar

Participate now!

Share