How long should your macro run?
Is there any way to determine its progress?
It is not possible to say how long the macro would take to run as that is dependent not only on the code, but also on the characteristics of your particular machine and environment.
I rewrote the macro in a manner which should significantly improve the speed. The re-written macro, run against the data that you provided which I copied and repeated down to 600,000 rows, took about five minutes to run.
However, I only disabled screen updating as there is nothing else on that worksheet of mine. If you have calculations which refer to the cells that are being altered, event triggered macros, and other calls on the resources, that can slow things down. All of those things can be disabled if they are an issue, but for now let's see if we can't get something running.
The way it has been rewritten, there is no way to determine its progress. The implementation of AdvancedFilter is an Excel feature, not VBA. Although it should execute much more quickly than looping through the rows of cells, I don't know of any way to monitor its progress.
However, there are issues with speed, function, and the AdvancedFilter in Excel especially when dealing with large data bases. I have developed a method which I think should run MUCH more quickly, but it is hard to test on a small database. It does assume that there are no duplicates in Column A, or if there are that you only want to display unique values. Is that a valid assumption?
The method needs a little refinement but with your database duplicated down to about 500,000 rows, it runs in less than five seconds. Of course, there are only seven entries in ColA that do not appear in Colb. I have not idea how it would run with a different data set. But try it and let me know.
Also, with this method, it would be possible to keep track of where it is.
Note the comment at the beginning about setting a reference. It will NOT run if that reference isn't set. If this will be distributed, we can use late binding, but not tonight.
===================================
Option Explicit
Sub PruneColA()
'Requires setting reference (tools/references) to
' Microsoft Scripting Runtime
Dim ws As Worksheet
Dim rColA As Range, rColB As Range
Dim vColA As Variant, vColB As Variant
Dim dColA As Dictionary, dColB As Dictionary
Dim i As Long
Dim d As Variant
Set dColA = New Dictionary
Set dColB = New Dictionary
Set ws = Worksheets("Sheet2")
With ws
Set rColA = Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))
Set rColB = Range(.Cells(1, "B"), .Cells(.Rows.Count, "B").End(xlUp))
End With
vColB = rColB
vColA = rColA
For i = LBound(vColB, 1) + 1 To UBound(vColB, 1)
With dColB
If Not .Exists(Key:=vColB(i, 1)) Then .Add Key:=vColB(i, 1), Item:=vColB(i, 1)
End With
Next i
For i = LBound(vColA, 1) + 1 To UBound(vColA, 1)
If Not dColB.Exists(Key:=vColA(i, 1)) Then
With dColA
If Not .Exists(Key:=vColA(i, 1)) Then .Add Key:=vColA(i, 1), Item:=vColA(i, 1)
End With
End If
Next i
ReDim vColA(1 To dColA.Count)
i = 0
For Each d In dColA
i = i + 1
vColA(i) = dColA(d)
Next d
rColA.Offset(rowoffset:=1).ClearContents
Set rColA = rColA.Resize(rowsize:=dColA.Count).Offset(rowoffset:=1)
rColA = WorksheetFunction.Transpose(vColA)
End Sub
+++++++++++++++++++++++++++++++
