Delete Rows based on 2 conditions

mrsushi

Board Regular
Joined
Nov 18, 2006
Messages
112
Office Version
  1. 2010
Trying to figure out how to tweak the below VBA code to delete duplicates. The current code deletes data which is duplicated in column B.
However, I need certain conditions met ie value in column B(Security) is duplicate, then look at Column D(Lad) and delete "DFL (if its in the column)

Any ideas please?
thanks
.

Option Explicit
Sub DeleteDuplicates1()

Dim x As Long
Dim LastRow As Long

LastRow = Range("B65536").End(xlUp).Row
For x = LastRow To 5 Step -1
If Application.WorksheetFunction.CountIf(Range("B5:B" & x), Range("B" & x).Text) > 1 Then
Range("B" & x).EntireRow.DELETE
End If
Next x

End Sub






TimeSecurityDescriptionLad
Close2001119AAR CORP COM USD1DFL
Close2001119AAR CORP COM USD1BID
Close2037062HELIX ENERGY SOLUTIONS GROUPDFL
Close2037062HELIX ENERGY SOLUTIONS GROUPBID
Close2108601BOEING CO,CMN US$5DFL
Close2108601BOEING CO,CMN US$5BID
Close2109723BOMBARDIER INC 'B' SUB VTG NPVDFL
Close2109723BOMBARDIER INC 'B' SUB VTG NPVBID
Close2130109ONEOK INC COM NPVDFL
Close2130109ONEOK INC COM NPVBID
Close2182531CORE LABORATORIES N.V. EUR0.04DFL
Close2182531CORE LABORATORIES N.V. EUR0.04BID
Close2186072CALLON PETROLEUM CO USD0.01DFL
Close2186072CALLON PETROLEUM CO USD0.01BID
Close2186254CENTURY ALUMINUM COMPANYDFL
Close2186254CENTURY ALUMINUM COMPANYBID
Close2387109GUESS COM US$0.01DFL
Close2387109GUESS COM US$0.01BID
Close2405302HALLIBURTON CO COM US$2.50DFL
Close2405302HALLIBURTON CO COM US$2.50BID
Close2408044HAWAIIAN HOLDINGS INCDFL
Close2408044HAWAIIAN HOLDINGS INCBID
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
One way...
(test on a COPY of your data)
VBA Code:
Sub DeleteDuplicates1()
    Dim x As Long, LastRow As Long, DFL As Boolean, Dup As Boolean
    LastRow = Range("B" & Rows.Count).End(xlUp).Row
    For x = LastRow To 5 Step -1
        DFL = (Cells(x, "D") = "DFL")
        Dup = (WorksheetFunction.CountIf(Range("B5:B" & LastRow), Cells(x, "B")) > 1)
        If Dup And DFL Then Range("B" & x).EntireRow.Delete
    Next x
End Sub



Remember to use code tags when posting code to make it easier to read
Click on <vba/> icon and paste code between the tags
[ CODE=vba ] PASTE CODE HERE [ /CODE ]
 

mrsushi

Board Regular
Joined
Nov 18, 2006
Messages
112
Office Version
  1. 2010
One way...
(test on a COPY of your data)
VBA Code:
Sub DeleteDuplicates1()
    Dim x As Long, LastRow As Long, DFL As Boolean, Dup As Boolean
    LastRow = Range("B" & Rows.Count).End(xlUp).Row
    For x = LastRow To 5 Step -1
        DFL = (Cells(x, "D") = "DFL")
        Dup = (WorksheetFunction.CountIf(Range("B5:B" & LastRow), Cells(x, "B")) > 1)
        If Dup And DFL Then Range("B" & x).EntireRow.Delete
    Next x
End Sub



Remember to use code tags when posting code to make it easier to read
Click on <vba/> icon and paste code between the tags
[ CODE=vba ] PASTE CODE HERE [ /CODE ]
That's worked perfect. Thanks Yongle
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
thanks for your feedback

This will run quicker if there is a lot of data
VBA Code:
Sub DeleteDuplicates2()
    Dim x As Long, LastRow As Long, DFL As Boolean, Dup As Boolean, Rng As Range
    LastRow = Range("B" & Rows.Count).End(xlUp).Row
    Set Rng = Range("B" & LastRow + 1)
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
            For x = LastRow To 5 Step -1
                DFL = (Cells(x, "D") = "DFL")
                Dup = (WorksheetFunction.CountIf(Range("B5:B" & LastRow), Cells(x, "B")) > 1)
                If Dup And DFL Then Set Rng = Union(Rng, Range("B" & x))
            Next x
            Rng.EntireRow.Delete
        .Calculation = xlCalculationAutomatic
    End With
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,129,404
Messages
5,636,095
Members
416,898
Latest member
imsorrymen

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top