Delete all but header and first visible row

Question

I've been tasked with removing duplicates from a dataset, but in a specific way; I need to apply a filter with two criteria, then remove all visible rows except the first one, which I will be editted on the fly.

I'm sure the solution rests with a loop filtering each criteria and deleting the relevant rows. However, I'm not sure how to go about it. Using offset is no good; setting and offsetting a range from used & visible cells doesn't seem to work; it always offsets from row 1, not the visible rows.

The range Dive is from the sheet WS, not the "Compilation Sheet" where the autofilter and duplication removal is taking place.

    Sub Dupe_killer()

Dim List As Worksheet
Dim Dive As Range
Dim Hit As Range
Set List = Sheets.Add
Dim aRow As Range
Dim fRow As Range
Dim lRow As Range
Dim r As Range
Dim Rng As Range
Dim FilterRange As Range

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With

Worksheets("Compilation Sheet").Activate

If ActiveSheet.FilterMode = False Then
    ActiveSheet.Range("A1:bc1").AutoFilter
End If

ActiveWorkbook.Worksheets("Compilation Sheet").AutoFilter.Sort.SortFields.Clear
ActiveSheet.Range("$A$1:$BC$11188").AutoFilter Field:=2, Criteria1:=RGB(255 _
    , 0, 255), Operator:=xlFilterCellColor

List.Range("A:A").Value = Worksheets("Compilation Sheet").Range("B:B").Value
List.Range("A:A").RemoveDuplicates Columns:=Array(1)

Set r = List.Range("A2")
Set Dive = Range(r, r.End(xlDown))

For Each Hit In Dive
    With Worksheets("Compilation Sheet")
    .Range("A1:BC1").AutoFilter Field:=2, Criteria1:=Hit
    .Range("A1:BC1").AutoFilter Field:=10, Criteria1:="*", Criteria2:="*,*", Operator:=xlAnd
    End With
    Set FilterRange = ActiveSheet.UsedRange.Offset(2, 0) _
    .SpecialCells(xlCellTypeVisible)
    FilterRange.Select
Next Hit

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With

End Sub

Check it out [Get unique items](http://www.xlorate.com/excel-questions.html#Get Unique Items) — Davesexcel, Apr 09 '15 at 15:21
This is a possible duplicate (at least from the title) of https://stackoverflow.com/questions/20663491/ where there is a very nice accessible solution. — B--rian, Apr 03 '19 at 06:27

score 0 · Answer 1 · answered Apr 09 '15 at 22:38

0

You want to set the range in Dive to be only the visible rows.

Google the syntax for

.SpecialCells(xlCellTypeVisible)

answered Apr 09 '15 at 22:38

rgo

481
4
11

score 0 · Answer 2 · answered Apr 10 '15 at 15:24

I think i've cracked it. Found a nifty bit of code for selecting the first visible cell. I could then hide that row and delete all visible.

Range("A2", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Select
ActiveCell.EntireRow.Hidden = True
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Delete

Delete all but header and first visible row

2 Answers2