find and remove... a repeating list

tourless

Board Regular
Joined
Feb 8, 2007
Messages
68
Office Version
  1. 365
Platform
  1. Windows
Hi Folks,

I'm copying a variable range of data which may or may not contain a repeating list of values in column A. In the case there IS a repeating list, I would like to keep only the first 'set' and delete all rows below. Turning this...

Prod1
Prod2
Prod3
Prod4
Prod5
Prod1
Prod2
Prod3
Prod4
Prod5
Prod1
Prod2
Prod3
Prod4
Prod5

into this...
Prod1
Prod2
Prod3
Prod4
Prod5

I think it could be as simple as holding the first instance of the first value (which will be in A2 due to header row), and looking for the second instance of that value and deleting it and everything below it. I need to add this functionality to a macro routine.
 

Some videos you may like

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,416
Office Version
  1. 365
Platform
  1. Windows
How about
Code:
Sub delDupes()
   Dim Cl As Range
   Dim Rng As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Nothing
         Else
            If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
         End If
      Next Cl
   End With
   If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,586
.
Code:
Option Explicit


Sub DupDel()


Columns("A:A").Select
ActiveSheet.Range("$A:$B").RemoveDuplicates Columns:=1, Header:=xlYes


'Uncomment next line and include RemoveBlankCells macro to delete all blank cells only in Col A
RemoveBlankCells


End Sub


Sub RemoveBlankCells()
'PURPOSE: Deletes single cells that are blank located inside a designated range
'SOURCE: www.TheSpreadsheetGuru.com


Dim rng As Range


'Store blank cells inside a variable
  On Error GoTo NoBlanksFound
    Set rng = Range("A:A").SpecialCells(xlCellTypeBlanks)
  On Error GoTo 0


'Delete blank cells and shift upward
  rng.Rows.Delete Shift:=xlShiftUp


Exit Sub


'ERROR HANLDER
NoBlanksFound:
    MsgBox "No Blank cells were found"


End Sub
 

tourless

Board Regular
Joined
Feb 8, 2007
Messages
68
Office Version
  1. 365
Platform
  1. Windows
Perfect, thank you... to you both!
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,416
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,109,142
Messages
5,527,064
Members
409,742
Latest member
setam

This Week's Hot Topics

Top