Progress/Counting Meter Problem

Hi,

I have tweaked a Macro that extracts data from workbooks within a given folder.

I have tried using the progress meters from links in this forum, but i could not make them to work.

what i need is a wait massage to show how many files in a folder and how many workbooks are being copied.

Can anyone help me with this problem.

Here's my Macro

Sub Extract_All()
    Dim wbSource As Workbook
    Dim wbThis As Workbook
    Dim rToCopy As Range
    Dim uRng   As Range
    Dim rNextCl As Range
    Dim lCount As Long
    Dim bHeaders As Boolean

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False

        On Error Resume Next

        Set wbThis = ThisWorkbook
        'clear the range except  headers
        Set uRng = wbThis.Worksheets(1).UsedRange
        If uRng.Cells.Count <= 1 Then
            'no data in master sheet
            bHeaders = False
            GoTo search
        End If
        uRng.Offset(1, 0).Resize(uRng.Rows.Count - 1, _
                                 uRng.Columns.Count).Clear
search:
        With .FileSearch
            .NewSearch
            'Change path to suit
            .LookIn = "C:\DataBase"
            .FileType = msoFileTypeExcelWorkbooks

            If .Execute > 0 Then    'Workbooks in folder
                For lCount = 1 To .FoundFiles.Count    ' Loop through all.
                    'Open Workbook x and Set a Workbook  variable to it
                    Set wbSource = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                    Set rToCopy = wbSource.Worksheets(1).UsedRange
                    Set rNextCl = wbThis.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                    If bHeaders Then
                        'headers exist so don't copy
                        rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                                    rToCopy.Columns.Count).Copy rNextCl
                        'no headers so copy
                        'place headers in Row 2
                    Else: rToCopy.Copy Cells(2, 1)
                        bHeaders = True
                    End If
                    wbSource.Close False     'close source workbook
                Next lCount
            Else: MsgBox "No workbooks found"
            End If
        End With


        On Error GoTo 0
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

Thanks

Panic

Hi

Inside your loop add a line to update the status bar

For lCount = 1 To .FoundFiles.Count    
  application.statusbar = "Actioning " & lcount & " of " & .foundfiles.count

Then as one of the last lines in your code add

application.statusbar = false

to clearout the statusbar.

HTH

rylo

Originally Posted by rylo

Hi

Inside your loop add a line to update the status bar

For lCount = 1 To .FoundFiles.Count    
  application.statusbar = "Actioning " & lcount & " of " & .foundfiles.count

Then as one of the last lines in your code add

application.statusbar = false

to clearout the statusbar.

HTH

rylo

I tried as you suggested, but i do not see anything happening. I am I missing something?

Thanks

Panic

Hi

At the bottom of the excel window is a (normally) grey border that contains the word Ready. If you do a filter, it will give you the number of items that have been filtered, or if you highlight a column of numbers, and the default action is Sum, then it will show you the sum.

In that bar, where Ready normally goes, it should produce the message from the code.

Let me know if that doesn't allow you to find it.

rylo

Hi rylo,

Thanks this works now (i was looking at the wrong thing)

But is it possible to display the status bar information on a message or a userform?

Thanks

Panic

Hi

Can't use a messagebox as you have to keep acknowledging it, so it comes back to using the progress meter. I don't know what link you used, but there used to be instructions on the microsoft.com site on how to create a progress meter. I found those instuctions workable.

Try attaching a file with your progress meter code / userform etc and maybe we can find where it isn't working.

rylo