Delete matching cells
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
===================================
|