Conditional removal of duplicates

[sucram3]

Hi,

I want to sort a column by removing duplicates, but not all duplicates, only those that appear in sequence, i.e:

1
2
3
3 (I want this removed)
4
2
3
2
2 (I want this removed)
3
4
4 (I want this removed)

Reason for this is that I'm trying to build a tree structure where various instances are used on different places in the structure, but not after each other.

I have searched this forum but haven't found anything that helps.

Thanks.

 

[Joe4]

Welcome to the Board!

What column is this data in and one what row does your data start?

 

[Joe4]

If your data started in cell A1, the VBA to do what you want would look something like this:

Sub MyDeleteDups()

    Dim lr As Long
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows backwards
    For r = lr To 2 Step -1
'       Delete current row if value in column A same as value above it
        If Cells(r, "A").Value = Cells(r - 1, "A").Value Then Rows(r).Delete
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

If it starts anywhere else, we would just need to make a few minor edits to the code above.

 

[AlanY]

you can filter/delete rows that are true

Book1
	A	B
1	1
2	2	FALSE
3	3	FALSE
4	3	TRUE
5	4	FALSE
6	2	FALSE
7	3	FALSE
8	2	FALSE
9	2	TRUE
10	3	FALSE
11	4	FALSE
12	4	TRUE
Sheet1

Cell Formulas
Range	Formula
B2:B12	B2	=A2=A1

Named Ranges
Name	Refers To	Cells
_FilterDatabase	=Sheet1!$A$1:$B$12	B2

 

[Joe4]

you can filter/delete rows that are true

Book1
	A	B
1	1
2	2	FALSE
3	3	FALSE
4	3	TRUE
5	4	FALSE
6	2	FALSE
7	3	FALSE
8	2	FALSE
9	2	TRUE
10	3	FALSE
11	4	FALSE
12	4	TRUE
Sheet1

Cell Formulas
Range	Formula
B2:B12	B2	=A2=A1

Named Ranges
Name	Refers To	Cells
_FilterDatabase	=Sheet1!$A$1:$B$12	B2

As you can see, there are multiple ways of accomplishing this.

Just to point out some differences with using Filters as opposed to VBA:
- this kind of filtering will require the use of a "helper" column
- filtering in place will only hide the rows, but nothing will be physically deleted.
- filtering to a new location will only return the rows that meet the criteria to a new location, but you will still have the original data fully intact in its original location

The advantage to using filters is it obviously does not require any VBA code.

Use whichever method suits your needs best!

 

[mohadin]

Hi
What about

Sub test()
Dim a: Dim c&, i&
    c = 1
    a = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
    ReDim b(1 To UBound(a))
    For i = 1 To UBound(a) - 1
        If a(i + 1, 1) <> a(i, 1) Then b(c) = a(i + 1, 1):   c = c + 1
    Next
Cells(2, 2).Resize(c) = Application.Transpose(b)
End Sub

Heder
1​	1​
2​	2​
3​	3​
3​	4​
4​	2​
2​	3​
3​	2​
2​	3​
3​	4​
4​
4​

 

[sucram3]

If your data started in cell A1, the VBA to do what you want would look something like this:

Sub MyDeleteDups()

    Dim lr As Long
    Dim r As Long
   
    Application.ScreenUpdating = False
   
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
'   Loop through all rows backwards
    For r = lr To 2 Step -1
'       Delete current row if value in column A same as value above it
        If Cells(r, "A").Value = Cells(r - 1, "A").Value Then Rows(r).Delete
    Next r
   
    Application.ScreenUpdating = True
   
End Sub

If it starts anywhere else, we would just need to make a few minor edits to the code above.

Thank you so much for this.

My data starts in cell D16.

How would the VBA change in that case? Change "A" to "D"?

 

[Joe4]

Thank you so much for this.

My data starts in cell D16.

How would the VBA change in that case? Change "A" to "D"?

Like this:

Sub MyDeleteDups()

    Dim lr As Long
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column D with data
    lr = Cells(Rows.Count, "D").End(xlUp).Row
    
'   Loop through all rows backwards
    For r = lr To 17 Step -1
'       Delete current row if value in column D same as value above it
        If Cells(r, "D").Value = Cells(r - 1, "D").Value Then Rows(r).Delete
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

 

[sucram3]

you can filter/delete rows that are true

Book1
	A	B
1	1
2	2	FALSE
3	3	FALSE
4	3	TRUE
5	4	FALSE
6	2	FALSE
7	3	FALSE
8	2	FALSE
9	2	TRUE
10	3	FALSE
11	4	FALSE
12	4	TRUE
Sheet1

Cell Formulas
Range	Formula
B2:B12	B2	=A2=A1

Named Ranges
Name	Refers To	Cells
_FilterDatabase	=Sheet1!$A$1:$B$12	B2

Hi!

This worked flawlessly.

Thank you so, so much!

BR

 

[sucram3]

Like this:

Sub MyDeleteDups()

    Dim lr As Long
    Dim r As Long
   
    Application.ScreenUpdating = False
   
'   Find last row in column D with data
    lr = Cells(Rows.Count, "D").End(xlUp).Row
   
'   Loop through all rows backwards
    For r = lr To 17 Step -1
'       Delete current row if value in column D same as value above it
        If Cells(r, "D").Value = Cells(r - 1, "D").Value Then Rows(r).Delete
    Next r
   
    Application.ScreenUpdating = True
   
End Sub

I tried this code and had it running for a while, and while testing 200 rows, it worked great. Although when running it on the complete set, all 250000 rows, it appeared to be a bit time consuming.

I'm so grateful for your time, despite my workbook being a bit too big.

Thank you.

BR