VBA Excel - How to remove duplicate based in two columns

0
votes

Excel Example as I can't post pictures

I've uploaded an image of the excel with some examples. What I need is:

  • Rows 3 and 4 are duplicated but the row 4 has data in "Dir" column. In this case delete both
  • Rows 12 and 13 are duplicated and no data in "Dir" column. In this case leave just one row

I've used Conditional Formatting to highlight the duplicates and use "IF" "Countif".... but have no luck and no clue how to get this done.

2
excelvba
Aaaaand what have you tried so far? – m02ph3u5
This may help : stackoverflow.com/help/how-to-ask – Stupid_Intern
I just have 'ActiveSheet.Range("A1:C" & K).RemoveDuplicates Columns:=1, Header:=xlYes' K is a string – Pedro Andrade
The following array formula, returns the row numbers of the duplicates=SMALL(IF((NOT(ISBLANK($C$2:$C$13))*(COUNTIFS($A$2:$A$13,$A$2:$A$13)>1)*(COUNTIFS($B$2:$B$13,$B$2:$B$13)>1)),ROW($A$2:$A$13)),ROWS($G$1:$G1))you could use the results from this to show duplicate rows... – Nathan_Sav
sorry, this one =SMALL(IF((NOT(ISBLANK($C$2:$C$13))*(COUNTIFS($A$2:$A$13,$A$2:$A$13,$B$2:$B$13,$B$2:$B$13)>1)),ROW($A$2:$A$13)),ROWS($G$1:$G1)) – Nathan_Sav

2 Answers

0
votes

For a formula based approach (with helper columns, you can do the below:

  1. D2 formula: =COUNTIFS($A$1:$A2,A2)
  2. E2 formula: =COUNTIFS($A$2:$A$33,A2,$C$2:$C$33,"LD")
  3. F2 formula: =IF(AND(COUNTIF($A$2:$A$21,A2)=1,E2=1),"Keep",IF(OR(AND(D2>0,E2>0),AND(D2>1,E2=0)),"Remove","Keep"))

Drag down and then filter on "Remove" and delete the visible cells.

enter image description here

0
votes

If you want a VBA option then this code will do it:

  Option Explicit

Sub DeleteDupes()

    Dim workingRow As Long
    Dim workingItem As String
    Dim i As Long
    Dim occurances As Variant

    'Skip past header row
    workingRow = 1

    Do Until Range("A" & workingRow + 1).value = ""

        workingRow = workingRow + 1
        workingItem = Range("A" & workingRow).value

        If Len(Range("C" & workingRow)) = 0 Then

            occurances = FncGetOccurances(workingRow, workingItem)

            If IsArray(occurances) Then

                FncDeleteRange (occurances)
                workingRow = workingRow - UBound(occurances)

            End If

        End If

    Loop

End Sub

Private Function FncDeleteRange(value As Variant)

    Dim deleteRange As Range
    Dim i As Long

    For i = 1 To UBound(value)

            If i = 1 Then

                Set deleteRange = Range("A" & value(i), "C" & value(i))
                deleteRange.Select

            Else

                Union(deleteRange, Range("A" & value(i), "C" & value(i))).Select

            End If
    Next i

    Selection.Delete Shift:=xlUp

End Function

Private Function FncGetOccurances(masterIndex As Long, value As String) As Variant

    Dim rowsToReturn As Variant
    Dim i As Long
    Dim currentCell As Long
    Dim itemCount As Long

    i = 1

    Do While Range("A" & i + 1).value <> ""

        i = i + 1
        currentCell = Range("A" & i).value

        If currentCell = value And _
            i <> masterIndex And _
            Len(Range("C" & i)) <> 0 Then

            itemCount = itemCount + 1

            If itemCount = 1 Then

                ReDim rowsToReturn(itemCount)

            Else

                ReDim Preserve rowsToReturn(itemCount)

            End If

            rowsToReturn(itemCount) = i

        End If

    Loop

    FncGetOccurances = rowsToReturn

End Function