Col A has 360,000 cells.
Col B has 240,000 cells.

A B
0000000021957 0000000022002
0000000022002 0000000032002
0000000031957 0000000032003
0000000032002 0000000042002
0000000032003 0000000052002
0000000042002 0000000052003
0000000052002 0000000062002
0000000052003 0000000102002
0000000061967 0000000121996
0000000061968 0000000142002
0000000062002 0000000152002
0000000081963 0000000162002
0000000102002 0000000481994
0000000121996 0000000481995
0000000142002 0000000481996
0000000152002 0000000481997
0000000162002 0000000481998
0000000341991 0000000481999
0000000401961 0000000482000

How can I delete the cells in Col A whose contents match cells in Col
B?

One method.

Insert a column left of Column A
Insert a row at top
Add titles in A1:C1..........will need for filtering


In A2 enter =COUNTIF($C$2:$C$20,B2)<0

D-click on fill handle to copy down to bottom of Column B

Select Columns A and B only

DataFilterAutofilter.

Filter for True on Column A

Select from A2 to bottom of Column B.

F5SpecialVisible CellsOK

EditClearContents

Remove Filter.

Select A and B then F5SpecialBlanksOK

EditDeleteShift Cells Up

Done


Gord

On Sat, 14 Jan 2012 09:26:02 -0800 (PST), gary
wrote:

Col A has 360,000 cells.
Col B has 240,000 cells.

A B
0000000021957 0000000022002
0000000022002 0000000032002
0000000031957 0000000032003
0000000032002 0000000042002
0000000032003 0000000052002
0000000042002 0000000052003
0000000052002 0000000062002
0000000052003 0000000102002
0000000061967 0000000121996
0000000061968 0000000142002
0000000062002 0000000152002
0000000081963 0000000162002
0000000102002 0000000481994
0000000121996 0000000481995
0000000142002 0000000481996
0000000152002 0000000481997
0000000162002 0000000481998
0000000341991 0000000481999
0000000401961 0000000482000

How can I delete the cells in Col A whose contents match cells in Col
B?

You posted in the Programming group so I guess VBA is in order.

Sub test()
For Each cell In Range("A1:A360000")
If WorksheetFunction.CountIf(Range("B1:B240000"), _
cell.Value) < 0 Then
cell.ClearContents
End If
Next
End Sub

You can get rid of the blanks after running.


Gord



On Sat, 14 Jan 2012 11:03:53 -0800, Gord Dibben
wrote:

One method.

Insert a column left of Column A
Insert a row at top
Add titles in A1:C1..........will need for filtering


In A2 enter =COUNTIF($C$2:$C$20,B2)<0

D-click on fill handle to copy down to bottom of Column B

Select Columns A and B only

DataFilterAutofilter.

Filter for True on Column A

Select from A2 to bottom of Column B.

F5SpecialVisible CellsOK

EditClearContents

Remove Filter.

Select A and B then F5SpecialBlanksOK

EditDeleteShift Cells Up

Done


Gord

On Sat, 14 Jan 2012 09:26:02 -0800 (PST), gary
wrote:

Col A has 360,000 cells.
Col B has 240,000 cells.

A B
0000000021957 0000000022002
0000000022002 0000000032002
0000000031957 0000000032003
0000000032002 0000000042002
0000000032003 0000000052002
0000000042002 0000000052003
0000000052002 0000000062002
0000000052003 0000000102002
0000000061967 0000000121996
0000000061968 0000000142002
0000000062002 0000000152002
0000000081963 0000000162002
0000000102002 0000000481994
0000000121996 0000000481995
0000000142002 0000000481996
0000000152002 0000000481997
0000000162002 0000000481998
0000000341991 0000000481999
0000000401961 0000000482000

How can I delete the cells in Col A whose contents match cells in Col
B?

On Jan 14, 11:19*am, Gord Dibben wrote:
You posted in the Programming group so I guess VBA is in order.

Sub test()
For Each cell In Range("A1:A360000")
If WorksheetFunction.CountIf(Range("B1:B240000"), _
cell.Value) < 0 *Then
cell.ClearContents
End If
Next
End Sub

You can get rid of the blanks after running.

Gord

On Sat, 14 Jan 2012 11:03:53 -0800, Gord Dibben
wrote:



One method.

Insert a column left of Column A
Insert a row at top
Add titles in A1:C1..........will need for filtering

In A2 enter * =COUNTIF($C$2:$C$20,B2)<0

D-click on fill handle to copy down to bottom of Column B

Select Columns A and B only

DataFilterAutofilter.

Filter for True on Column A

Select from A2 to bottom of Column B.

F5SpecialVisible CellsOK

EditClearContents

Remove Filter.

Select A and B then F5SpecialBlanksOK

EditDeleteShift Cells Up

Done

Gord

On Sat, 14 Jan 2012 09:26:02 -0800 (PST), gary
wrote:

Col A has 360,000 cells.
Col B has 240,000 cells.

* * * * * * A * * * * * * * * * * * * * * * * * *B
0000000021957 * 0000000022002
0000000022002 * 0000000032002
0000000031957 * 0000000032003
0000000032002 * 0000000042002
0000000032003 * 0000000052002
0000000042002 * 0000000052003
0000000052002 * 0000000062002
0000000052003 * 0000000102002
0000000061967 * 0000000121996
0000000061968 * 0000000142002
0000000062002 * 0000000152002
0000000081963 * 0000000162002
0000000102002 * 0000000481994
0000000121996 * 0000000481995
0000000142002 * 0000000481996
0000000152002 * 0000000481997
0000000162002 * 0000000481998
0000000341991 * 0000000481999
0000000401961 * 0000000482000

How can I delete the cells in Col A whose contents match cells in Col
B?- Hide quoted text -

- Show quoted text -

Hi Gord,

How long should your macro run? (It's been running for more than 2
hours). Is there any way to determine its progress?

I have no idea how long it should take but 2 hours+ sounds a little
much.

I ran it on about 100 rows which is somewhat smaller than the range
you have. Took a second.

See Ron's macro..........proably much faster than a loop.

Did you try the manual method?


Gord



On Sat, 14 Jan 2012 14:19:10 -0800 (PST), gary
wrote:

On Jan 14, 11:19*am, Gord Dibben wrote:
You posted in the Programming group so I guess VBA is in order.

Sub test()
For Each cell In Range("A1:A360000")
If WorksheetFunction.CountIf(Range("B1:B240000"), _
cell.Value) < 0 *Then
cell.ClearContents
End If
Next
End Sub

You can get rid of the blanks after running.

Gord

On Sat, 14 Jan 2012 11:03:53 -0800, Gord Dibben
wrote:



One method.

Insert a column left of Column A
Insert a row at top
Add titles in A1:C1..........will need for filtering

In A2 enter * =COUNTIF($C$2:$C$20,B2)<0

D-click on fill handle to copy down to bottom of Column B

Select Columns A and B only

DataFilterAutofilter.

Filter for True on Column A

Select from A2 to bottom of Column B.

F5SpecialVisible CellsOK

EditClearContents

Remove Filter.

Select A and B then F5SpecialBlanksOK

EditDeleteShift Cells Up

Done

Gord

On Sat, 14 Jan 2012 09:26:02 -0800 (PST), gary
wrote:

Col A has 360,000 cells.
Col B has 240,000 cells.

* * * * * * A * * * * * * * * * * * * * * * * * *B
0000000021957 * 0000000022002
0000000022002 * 0000000032002
0000000031957 * 0000000032003
0000000032002 * 0000000042002
0000000032003 * 0000000052002
0000000042002 * 0000000052003
0000000052002 * 0000000062002
0000000052003 * 0000000102002
0000000061967 * 0000000121996
0000000061968 * 0000000142002
0000000062002 * 0000000152002
0000000081963 * 0000000162002
0000000102002 * 0000000481994
0000000121996 * 0000000481995
0000000142002 * 0000000481996
0000000152002 * 0000000481997
0000000162002 * 0000000481998
0000000341991 * 0000000481999
0000000401961 * 0000000482000

How can I delete the cells in Col A whose contents match cells in Col
B?- Hide quoted text -

- Show quoted text -

Hi Gord,

How long should your macro run? (It's been running for more than 2
hours). Is there any way to determine its progress?

On Jan 14, 3:01*pm, Gord Dibben wrote:
I have no idea how long it should take but 2 hours+ sounds a little
much.

I ran it on about 100 rows which is somewhat smaller than the range
you have. *Took a second.

See Ron's macro..........proably much faster than a loop.

Did you try the manual method?

Gord

On Sat, 14 Jan 2012 14:19:10 -0800 (PST), gary
wrote:



On Jan 14, 11:19*am, Gord Dibben wrote:
You posted in the Programming group so I guess VBA is in order.

Sub test()
For Each cell In Range("A1:A360000")
If WorksheetFunction.CountIf(Range("B1:B240000"), _
cell.Value) < 0 *Then
cell.ClearContents
End If
Next
End Sub

You can get rid of the blanks after running.

Gord

On Sat, 14 Jan 2012 11:03:53 -0800, Gord Dibben
wrote:

One method.

Insert a column left of Column A
Insert a row at top
Add titles in A1:C1..........will need for filtering

In A2 enter * =COUNTIF($C$2:$C$20,B2)<0

D-click on fill handle to copy down to bottom of Column B

Select Columns A and B only

DataFilterAutofilter.

Filter for True on Column A

Select from A2 to bottom of Column B.

F5SpecialVisible CellsOK

EditClearContents

Remove Filter.

Select A and B then F5SpecialBlanksOK

EditDeleteShift Cells Up

Done

Gord

On Sat, 14 Jan 2012 09:26:02 -0800 (PST), gary
wrote:

Col A has 360,000 cells.
Col B has 240,000 cells.

* * * * * * A * * * * * * * * * * * * * * * * * *B
0000000021957 * 0000000022002
0000000022002 * 0000000032002
0000000031957 * 0000000032003
0000000032002 * 0000000042002
0000000032003 * 0000000052002
0000000042002 * 0000000052003
0000000052002 * 0000000062002
0000000052003 * 0000000102002
0000000061967 * 0000000121996
0000000061968 * 0000000142002
0000000062002 * 0000000152002
0000000081963 * 0000000162002
0000000102002 * 0000000481994
0000000121996 * 0000000481995
0000000142002 * 0000000481996
0000000152002 * 0000000481997
0000000162002 * 0000000481998
0000000341991 * 0000000481999
0000000401961 * 0000000482000

How can I delete the cells in Col A whose contents match cells in Col
B?- Hide quoted text -

- Show quoted text -

Hi Gord,

How long should your macro run? *(It's been running for more than 2
hours). *Is there any way to determine its progress?- Hide quoted text -

- Show quoted text -

In your =Count formula, I changed $C$20 to $C$239820 (which is the
number of cells in my spreadsheet)

When copying that formula down to the bottom of Col B, it's already
taken 30 minutes and "Calculating" is at 4%..






..

On Sat, 14 Jan 2012 09:26:02 -0800 (PST), gary wrote:

Col A has 360,000 cells.
Col B has 240,000 cells.

A B
0000000021957 0000000022002
0000000022002 0000000032002
0000000031957 0000000032003
0000000032002 0000000042002
0000000032003 0000000052002
0000000042002 0000000052003
0000000052002 0000000062002
0000000052003 0000000102002
0000000061967 0000000121996
0000000061968 0000000142002
0000000062002 0000000152002
0000000081963 0000000162002
0000000102002 0000000481994
0000000121996 0000000481995
0000000142002 0000000481996
0000000152002 0000000481997
0000000162002 0000000481998
0000000341991 0000000481999
0000000401961 0000000482000

How can I delete the cells in Col A whose contents match cells in Col
B?

Here's another macro, using the AdvancedFilter.
Please do this on a copy of your data.

You will need to set ws to the proper worksheet. I used Sheet2.

=============================
Option Explicit
Sub PruneColA()
Dim ws As Worksheet
Dim rColA As Range, rColB As Range
Dim c As Range
Dim rCrit As Range
Dim i As Long
Dim v As Variant
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))
Set rCrit = .UsedRange.Resize(rowsize:=2, columnsize:=1).Offset _
(columnoffset:=.UsedRange.Columns.Count + 2)
End With

Application.ScreenUpdating = False

rCrit(1).ClearContents
rCrit(2) = "=countif(" & rColB.Address & "," & rColA(2).Address(False, False) & ")0"

With rColA
.AdvancedFilter Action:=xlFilterInPlace, criteriarange:=rCrit
End With

rCrit.EntireColumn.Delete

On Error Resume Next
rColA.Offset(rowoffset:=1).Resize(rowsize:=rColA.R ows.Count - 1) _
.SpecialCells(xlCellTypeVisible).ClearContents
On Error GoTo 0

i = 0
ReDim v(1 To WorksheetFunction.CountA(rColA))
For Each c In rColA
c.EntireRow.RowHeight = 15
If c.Value < "" Then
i = i + 1
v(i) = c.Text
End If
Next c

rColA.ClearContents
Set rColA = rColA.Resize(rowsize:=UBound(v))
rColA = WorksheetFunction.Transpose(v)

Application.ScreenUpdating = True

End Sub
===================================

On Jan 14, 2:31*pm, Ron Rosenfeld wrote:
On Sat, 14 Jan 2012 09:26:02 -0800 (PST), gary wrote:
Col A has 360,000 cells.
Col B has 240,000 cells.

* * * * * * A * * * * * * * * * * * * * * * * * *B
0000000021957 * * * 0000000022002
0000000022002 * * * 0000000032002
0000000031957 * * * 0000000032003
0000000032002 * * * 0000000042002
0000000032003 * * * 0000000052002
0000000042002 * * * 0000000052003
0000000052002 * * * 0000000062002
0000000052003 * * * 0000000102002
0000000061967 * * * 0000000121996
0000000061968 * * * 0000000142002
0000000062002 * * * 0000000152002
0000000081963 * * * 0000000162002
0000000102002 * * * 0000000481994
0000000121996 * * * 0000000481995
0000000142002 * * * 0000000481996
0000000152002 * * * 0000000481997
0000000162002 * * * 0000000481998
0000000341991 * * * 0000000481999
0000000401961 * * * 0000000482000

How can I delete the cells in Col A whose contents match cells in Col
B?

Here's another macro, using the AdvancedFilter.
Please do this on a copy of your data.

You will need to set ws to the proper worksheet. *I used Sheet2.

=============================
Option Explicit
Sub PruneColA()
* * Dim ws As Worksheet
* * Dim rColA As Range, rColB As Range
* * Dim c As Range
* * Dim rCrit As Range
* * Dim i As Long
* * Dim v As Variant
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))
* * Set rCrit = .UsedRange.Resize(rowsize:=2, columnsize:=1).Offset _
* * * * (columnoffset:=.UsedRange.Columns.Count + 2)
End With

Application.ScreenUpdating = False

rCrit(1).ClearContents
rCrit(2) = "=countif(" & rColB.Address & "," & rColA(2).Address(False, False) & ")0"

With rColA
* * .AdvancedFilter Action:=xlFilterInPlace, criteriarange:=rCrit
End With

rCrit.EntireColumn.Delete

On Error Resume Next
rColA.Offset(rowoffset:=1).Resize(rowsize:=rColA.R ows.Count - 1) _
* * .SpecialCells(xlCellTypeVisible).ClearContents
On Error GoTo 0

i = 0
ReDim v(1 To WorksheetFunction.CountA(rColA))
For Each c In rColA
* * c.EntireRow.RowHeight = 15
* * If c.Value < "" Then
* * * * i = i + 1
* * * * v(i) = c.Text
* * End If
Next c

rColA.ClearContents
Set rColA = rColA.Resize(rowsize:=UBound(v))
rColA = WorksheetFunction.Transpose(v)

Application.ScreenUpdating = True

End Sub
===================================- Hide quoted text -

- Show quoted text -

How long should your macro run?
Is there any way to determine its progress?

On Sat, 14 Jan 2012 15:15:17 -0800 (PST), gary wrote:

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(rowoffse t:=1)
rColA = WorksheetFunction.Transpose(vColA)

End Sub
+++++++++++++++++++++++++++++++

On Jan 14, 8:52*pm, Ron Rosenfeld wrote:
On Sat, 14 Jan 2012 15:15:17 -0800 (PST), gary wrote:
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(rowoffse t:=1)
rColA = WorksheetFunction.Transpose(vColA)

End Sub
+++++++++++++++++++++++++++++++


Run-time Error '13'
Type Mismatch in

rColA = WorksheetFunction.Transpose(vColA)

On Jan 14, 8:52*pm, Ron Rosenfeld wrote:
On Sat, 14 Jan 2012 15:15:17 -0800 (PST), gary wrote:
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(rowoffse t:=1)
rColA = WorksheetFunction.Transpose(vColA)

End Sub
+++++++++++++++++++++++++++++++

I have deleted the duplicates in col A and in Col B.

When I re-ran your macro, I still got the Run-time Error '13'
Type Mismatch in

rColA = WorksheetFunction.Transpose(vColA)

On Sat, 14 Jan 2012 22:08:27 -0800 (PST), gary wrote:

I have deleted the duplicates in col A and in Col B.

When I re-ran your macro, I still got the Run-time Error '13'
Type Mismatch in

rColA = WorksheetFunction.Transpose(vColA)


The presence or absence of duplicates is irrelevant to this error. I cannot be sure, but in older versions of Excel (prior to 2003) there were limits in the size of an array that you could use worksheetfunction.transpose. I thought it had been removed, but perhaps not.

How long did the macro run before hitting that error? Because that's at the end and the next step would be quick.

Try this variation where transposing is not required:

==================================
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, 1 To 1)
i = 0
For Each d In dColA
i = i + 1
vColA(i, 1) = dColA(d)
Next d

rColA.Offset(rowoffset:=1).ClearContents
Set rColA = rColA.Resize(rowsize:=dColA.Count).Offset(rowoffse t:=1)

rColA = vColA

End Sub
===================================

On Sat, 14 Jan 2012 22:08:27 -0800 (PST), gary wrote:

I have deleted the duplicates in col A and in Col B.

When I re-ran your macro, I still got the Run-time Error '13'
Type Mismatch in

rColA = WorksheetFunction.Transpose(vColA)

Gary,

If the last version I provided, which does NOT use TRANSPOSE, doesn't work, we will have to transfer the data to ColA using a loop. It may be that we are running into one of the limitations of VBA and Excel.

On Jan 14, 2:31*pm, Ron Rosenfeld wrote:
On Sat, 14 Jan 2012 09:26:02 -0800 (PST), gary wrote:
Col A has 360,000 cells.
Col B has 240,000 cells.

* * * * * * A * * * * * * * * * * * * * * * * * *B
0000000021957 * * * 0000000022002
0000000022002 * * * 0000000032002
0000000031957 * * * 0000000032003
0000000032002 * * * 0000000042002
0000000032003 * * * 0000000052002
0000000042002 * * * 0000000052003
0000000052002 * * * 0000000062002
0000000052003 * * * 0000000102002
0000000061967 * * * 0000000121996
0000000061968 * * * 0000000142002
0000000062002 * * * 0000000152002
0000000081963 * * * 0000000162002
0000000102002 * * * 0000000481994
0000000121996 * * * 0000000481995
0000000142002 * * * 0000000481996
0000000152002 * * * 0000000481997
0000000162002 * * * 0000000481998
0000000341991 * * * 0000000481999
0000000401961 * * * 0000000482000

How can I delete the cells in Col A whose contents match cells in Col
B?

Here's another macro, using the AdvancedFilter.
Please do this on a copy of your data.

You will need to set ws to the proper worksheet. *I used Sheet2.

=============================
Option Explicit
Sub PruneColA()
* * Dim ws As Worksheet
* * Dim rColA As Range, rColB As Range
* * Dim c As Range
* * Dim rCrit As Range
* * Dim i As Long
* * Dim v As Variant
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))
* * Set rCrit = .UsedRange.Resize(rowsize:=2, columnsize:=1).Offset _
* * * * (columnoffset:=.UsedRange.Columns.Count + 2)
End With

Application.ScreenUpdating = False

rCrit(1).ClearContents
rCrit(2) = "=countif(" & rColB.Address & "," & rColA(2).Address(False, False) & ")0"

With rColA
* * .AdvancedFilter Action:=xlFilterInPlace, criteriarange:=rCrit
End With

rCrit.EntireColumn.Delete

On Error Resume Next
rColA.Offset(rowoffset:=1).Resize(rowsize:=rColA.R ows.Count - 1) _
* * .SpecialCells(xlCellTypeVisible).ClearContents
On Error GoTo 0

i = 0
ReDim v(1 To WorksheetFunction.CountA(rColA))
For Each c In rColA
* * c.EntireRow.RowHeight = 15
* * If c.Value < "" Then
* * * * i = i + 1
* * * * v(i) = c.Text
* * End If
Next c

rColA.ClearContents
Set rColA = rColA.Resize(rowsize:=UBound(v))
rColA = WorksheetFunction.Transpose(v)

Application.ScreenUpdating = True

End Sub
===================================- Hide quoted text -

- Show quoted text -


Your macro (using the Advanced Filter) is getting Run-time Error
'1004' of "AdvancedFilter method of Range clsss failed".

Note: I've set ws = Worksheets("Sheet1")

On Sat, 14 Jan 2012 19:33:33 -0800 (PST), gary wrote:

Your macro (using the Advanced Filter) is getting Run-time Error
'1004' of "AdvancedFilter method of Range clsss failed".

Note: I've set ws = Worksheets("Sheet1")


As I wrote, previously, there are problems with AdvancedFilter in very large databases in certain environments. This may or may not have been resolved in Excel 2010

Also see my latest posting from today.

One way...

Option Explicit

Sub StripDupes()
Dim i&, j&, lRows1&, lRows2&, lLastRow& 'as long
Dim vRng As Variant
lRows1 = Cells(Rows.Count, "A").End(xlUp).Row
lRows2 = Cells(Rows.Count, "B").End(xlUp).Row
If lRows1 lRows2 Then lLastRow = lRows1 Else lLastRow = lRows2
vRng = Range("A1:B" & lLastRow)
For i = UBound(vRng) To 1 Step -1
If Not vRng(i, 1) = "" Then
For j = 1 To UBound(vRng)
If vRng(i, 1) = vRng(j, 2) Then
Cells(i, 1).Delete shift:=xlUp: Exit For
End If
Next 'j
End If
Next 'i
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

You can speed it up by turning ScreenUpdating off...

One way...

Option Explicit

Sub StripDupes()
Dim i&, j&, lRows1&, lRows2&, lLastRow& 'as long
Dim vRng As Variant
lRows1 = Cells(Rows.Count, "A").End(xlUp).Row
lRows2 = Cells(Rows.Count, "B").End(xlUp).Row
If lRows1 lRows2 Then lLastRow = lRows1 Else lLastRow = lRows2
vRng = Range("A1:B" & lLastRow)
Application.ScreenUpdating = False
For i = UBound(vRng) To 1 Step -1
If Not vRng(i, 1) = "" Then
For j = 1 To UBound(vRng)
If vRng(i, 1) = vRng(j, 2) Then
Cells(i, 1).Delete shift:=xlUp: Exit For
End If
Next 'j
End If
Next 'i
Application.ScreenUpdating = True
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

You can further optimize performance as follows...

Option Explicit

Sub StripDupes()
Dim i&, j&, lRows1&, lRows2&, lLastRow&, lCalcMode& 'as long
Dim vRng As Variant, bEventsEnabled As Boolean

lRows1 = Cells(Rows.Count, "A").End(xlUp).Row
lRows2 = Cells(Rows.Count, "B").End(xlUp).Row
If lRows1 lRows2 Then lLastRow = lRows1 Else lLastRow = lRows2
vRng = Range("A1:B" & lLastRow)

With Application
lCalcMode = .Calculation: .Calculation = xlCalculationManual
bEventsEnabled = .EnableEvents: .EnableEvents = False
.ScreenUpdating = False
End With

For i = UBound(vRng) To 1 Step -1
If Not vRng(i, 1) = "" Then
For j = 1 To UBound(vRng)
If vRng(i, 1) = vRng(j, 2) Then
Cells(i, 1).Delete shift:=xlUp: Exit For
End If
Next 'j
End If
Next 'i

'Cleanup
With Application
.Calculation = lCalcMode
.EnableEvents = bEventsEnabled
.ScreenUpdating = True
End With
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc