Remove range of cells based on unique condition

kypok999

New Member
Joined
Oct 20, 2017
Messages
41
Hi Guys,

I have big excel file I have unique ID then client and price the issue i have unique ID can be the same on 7 raws I need to remove all of inuqie ids based if price is lower then 3 but I need to delete all 7 raws as price of first can be 2.94 but second 4.54 see example:

[TABLE="width: 242"]
<colgroup><col><col span="2"></colgroup><tbody>[TR]
[TD="align: right"]121518578[/TD]
[TD][/TD]
[TD="align: right"]2.989445[/TD]
[/TR]
[TR]
[TD="align: right"]121518578[/TD]
[TD][/TD]
[TD="align: right"]4.065677[/TD]
[/TR]
[TR]
[TD="align: right"]121518578[/TD]
[TD][/TD]
[TD="align: right"]8.4[/TD]
[/TR]
[TR]
[TD="align: right"][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: right"]121518578[/TD]
[TD][/TD]
[TD="align: right"]170.6262[/TD]
[/TR]
[TR]
[TD="align: right"]121637552[/TD]
[TD][/TD]
[TD="align: right"]5.855528[/TD]
[/TR]
</tbody>[/TABLE]
So I want to delete top4 and then keep next because Price is over 5.8

Thank u
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
You would get better responses if you identified the sheet name and columns in which your data is located. Based on your example, you want to evaluate only the first occurrence of each unique ID and either delete or keep all other rows with that ID, regardless of the price on the following occurrences of the same ID. Is that correct?
 
Upvote 0
This assumes the data is in columns A and B. You can try it on a copy of your file or a mock up to see if it is what you want. Copy the code to your code module1.

Code:
Sub t()
Dim sh As Worksheet, c As Range, fn As Range, lr As Long
Set sh = ActiveSheet
With sh
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(Rows.Count, 2).End(xlUp)(3), True
    For Each c In .Cells(Rows.Count, 2).End(xlUp).CurrentRegion.Offset(1)
        lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
        If c <> "" Then
        Set fn = .Range("A2:A" & lr).Find(c.Value, , xlValues)
            If Not fn Is Nothing Then
                If fn.Offset(, 1).Value < 3 Then
                    .Range("A1:A" & lr).AutoFilter 1, c.Value
                    .Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).Delete xlShiftUp
                    .AutoFilterMode = False
                End If
            End If
        End If
    Next
    .Cells(Rows.Count, 2).End(xlUp).CurrentRegion.ClearContents
End With
End Sub
 
Upvote 0
Thank you JLGWhiz it seems to work the only thing that i should have mentioned i have more data then column a and b sorry i have as in picture from raw A to AC and the unique id is in column D and price is in column Q I attached picture I want if criteria is met and price is less then 3 then all raws with that unique id to be deleted from as in example below i want A2:AC14 to be deleted

https://imgur.com/a/xTmN7

Thank you very much

 
Upvote 0
Thank you JLGWhiz it seems to work the only thing that i should have mentioned i have more data then column a and b sorry i have as in picture from raw A to AC and the unique id is in column D and price is in column Q I attached picture I want if criteria is met and price is less then 3 then all raws with that unique id to be deleted from as in example below i want A2:AC14 to be deleted

https://imgur.com/a/xTmN7

Thank you very much

the code has been modified per post #4 . Re-test it before applying it to your original file.
Code:
Sub t2()
Dim sh As Worksheet, c As Range, fn As Range, lr As Long
Set sh = ActiveSheet
With sh
    .Range("D1", .Cells(Rows.Count, 4).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(Rows.Count, 2).End(xlUp)(3), True
    For Each c In .Cells(Rows.Count, 2).End(xlUp).CurrentRegion.Offset(1)
        lr = sh.Cells(Rows.Count, 4).End(xlUp).Row
        If c <> "" Then
        Set fn = .Range("D2:A" & lr).Find(c.Value, , xlValues)
            If Not fn Is Nothing Then
                If fn.Offset(, 13).Value < 3 Then
                    .Range("A1:AC" & lr).AutoFilter 4, c.Value
                    .Range("A2:AC" & lr).SpecialCells(xlCellTypeVisible).Delete xlShiftUp
                    .AutoFilterMode = False
                End If
            End If
        End If
    Next
    .Cells(Rows.Count, 2).End(xlUp).CurrentRegion.ClearContents
End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

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
Back
Top