excel vba progress indicator

[robertvdb]

I have an xlsm, which contains (among many more) 2 sheets. Both sheets have about 500,000 cells with figures.

A macro runs, which compares each cell(i,j) on both sheets, verifying if the i-j values are the same.

This macro takes some 30 seconds to run.

I would like to show a progress bar, indicating the execution of this macro.

Can anyone indicate how to do this ?

Thanks.

 

[DanteAmor]

Post the macro here for review, maybe it can be improved and then no progress bar will be needed.
Accompany your macro with examples (10 or 15 records) of both sheets (use XL2BB tool) and the expected result, also explain a little how you get to that result.

Note Code Tag:
How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.

NOTE XL2BB:
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in
Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

And if there's no improvement, then I'll find a way to create a progress bar.

---

 

[robertvdb]

Private Sub UserForm_Activate()
code
End Sub

Sub progress(pctCompl As Single)

UserForm_Progress.lblText.Caption = pctCompl & "%  completed"
UserForm_Progress.lblBar.Width = pctCompl * 2

DoEvents

End Sub


Sub code()
Dim n As Long
Dim colsBK As Range
Dim colsBKCell As Range
Dim answer As Variant
Dim i As Integer
Dim pctCompl As Single

On Error GoTo 0

For i = 0 To 100 Step 20   'i is the progressbar percentage indicator.  I use Step 20 to speed up the progress, but ideally this should be step 1

    '*****************************************************************************************
    'STAGE 1 compare the figures in columns B to K with the corresponding cells in Sheet OLD
    '*****************************************************************************************
    n = 0   'n is the number of differences
 
    Set colsBK = Range("B2", Range("B65536").End(xlUp).Offset(0, 9))
 
    For Each colsBKCell In colsBK
    If Not colsBKCell.Value = Sheets("old").Cells(colsBKCell.Row, colsBKCell.Column).Value Then
        colsBKCell.Interior.ColorIndex = 3
        n = n + 1
    Else
        colsBKCell.Interior.ColorIndex = 0
    End If
    Next colsBKCell
 
    pctCompl = i
    progress pctCompl

Next i
 
    '*****************************************************************************************
    'STAGE 2 If n>0 then ask for reset
    '*****************************************************************************************
    If n > 0 Then
 
        answer = MsgBox("Reset figures ?", vbYesNo)
        If answer = vbNo Then
            Unload UserForm_Progress
            Exit Sub
        Else
            Application.ScreenUpdating = False
            For Each colsBKCell In colsBK
                colsBKCell.Value = Sheets("old").Cells(colsBKCell.Row, colsBKCell.Column).Value
                colsBKCell.Interior.ColorIndex = 0
            Next colsBKCell
            Application.ScreenUpdating = True
            MsgBox ("Reset completed"), vbInformation
        End If
     
    Else
    End If

 
MsgBox (n & " differences")
Unload UserForm_Progress

End Sub