0

I cannot ge to work the following code: I have a table with 2 columns. The first column stores the item name (2 possible names: 'Book' and 'Keyboard) and column 2 stores the numbers. I want to write the code according to which if there are idenitcal numbers in column 2 along both possible Item names, then the item name 'Keyboard' should dominate and all numbers in column 2 along the name 'Book' should be deleted.

This is, how the case looks before running the code: enter image description here

And this is my desired outcome:

enter image description here

I was trying to work with the code below but it doesn't work right. I am also not sure if there should not be used another procedure like arrays?

Sub RemoveDuplicate()

 Dim ws1 As Worksheet
 Set ws1 = Sheets("Sheet1")
 Dim cell As Range
 Dim rng_delete As Range
 Dim rng_Item As Range
 Dim LastRow As Integer

With ws1
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set rng_delete = .Range(.Cells(3, 1), .Cells(LastRow, 2))
    Set rng_Item = .Range(.Cells(3, 1), .Cells(LastRow, 1))


        For Each cell In rng_Item
            If cell.Value <> "Keyboard" Then
                rng_delete.RemoveDuplicates Columns:=2, Header:=xlYes
            End If
        Next cell
End With

End Sub

I would appreciate any help.

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
Dozens
  • 145
  • 1
  • 9
  • 2
    Why not just sort so that `Keyboard` is on top and use the built in Remove Duplicates to remove based on duplicates in the `Number` column? Remove Duplicates keeps the first occurrence by default, so that would achieve what you're looking for. – Tate Garringer Feb 28 '19 at 13:34
  • Please note that row counting variables **must** be of type `Long` because Excel has more rows than `Integer` can handle: `Dim LastRow As Long`. – Pᴇʜ Feb 28 '19 at 14:51
  • @TateGarringer , you are right with sorting it deletes. But there is still the problem because then it deletes also the duplicated numbers along 'Keyboard' items, and these I don't want to delete. Only the ones that duplicated on the 'Book' items – Dozens Feb 28 '19 at 17:37

2 Answers2

1

Based on your comments and your desire to keep duplicates of Number as long as the duplicates are Keyboard in Item, I would use a helper column and a couple AutoFilters to define a range to delete. I tested this with a recreation of your data.

Sub DeleteSpecificDuplicates()
    Dim endrow As Long
    Dim dRng As Range
    With ThisWorkbook.Worksheets("Sheet1")
        endrow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("C2") = "tempCount"
        .Range("C3").Formula = "=COUNTIF(" & .Range("B3:B" & endrow).Address & ",B3)"
        .Range("C3:C" & endrow).FillDown
        With .Range("A2:C" & endrow)
            .AutoFilter Field:=1, Criteria1:="<>Keyboard"
            .AutoFilter Field:=3, Criteria1:=">1"
        End With
        If WorksheetFunction.Subtotal(3, .Range("A3:A" & endrow)) > 0 Then
            Set dRng = .Range("A3:C" & endrow).SpecialCells(xlCellTypeVisible)
            .AutoFilterMode = False
            dRng.Delete Shift:=xlUp
        End If
        If .AutoFilterMode = True Then .AutoFilterMode = False
        .Columns(3).ClearContents
    End With
End Sub

This would define a range where Item <> Keyboard and the count of the Number occurrences is >1, and subsequently delete that specified range.

Tate Garringer
  • 1,509
  • 1
  • 6
  • 9
  • That's perfect. I have tested it and works great. Would you know how to rewrite it if I have actual table as with ListObjects property? Or should I designate for another post? – Dozens Mar 01 '19 at 16:19
  • 1
    I answered a [similar question](https://stackoverflow.com/questions/54659070/delete-table-row-based-on-criteria-vba/54659564#54659564) that will get you on the right track for deleting table rows from a referenced table. – Tate Garringer Mar 01 '19 at 17:16
  • Happy to have helped. – Tate Garringer Mar 01 '19 at 18:42
0

Try this, it works for me. Seems you have to include the top row otherwise it ignores the first value. And you have to remove duplicates for books rather than keyboard.

Sub RemoveDuplicate()

 Dim ws1 As Worksheet
 Set ws1 = Sheets("Sheet1")
 Dim cell As Range
 Dim rng_delete As Range
 Dim rng_Item As Range
 Dim LastRow As Long

With ws1
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

    Set rng_delete = .Range(.Cells(1, 1), .Cells(LastRow, 2))
    Set rng_Item = .Range(.Cells(1, 1), .Cells(LastRow, 1))


        For Each cell In rng_Item
            If cell.Value <> "Book" Then
                rng_delete.RemoveDuplicates Columns:=2, Header:=xlYes
            End If
        Next cell
End With


End Sub
  • Yeah now it deletes, but only the items for Keyboard and not for the book. Actually, no matter whether in condition is 'keyboard' or 'Book', the keyboard items are deleted instead of the book items – Dozens Feb 28 '19 at 17:21
  • Now I found, that I have to sort the range first so it starts from the keyboard. Then, book items are deleted. But still, if the 'keyboard' items have duplicated numbers in col2, I don't want to remove them, only if there are duplicated numbers with the book. How to achieve that? – Dozens Feb 28 '19 at 17:32
  • I wanted to get the outcome exactly as in the 2nd picture – Dozens Feb 28 '19 at 17:35