Removing Duplicate Row based on a single difference between them

Clauddvon

New Member
Joined
Jun 7, 2005
Messages
22
Hello,

I have an Excel spreadsheet that contains the following columns:

AGENCY FORM_NUMBER TYPE_DESCRIPTION DEFAULT_SIDE FORM_CREATE_DATE COUNT(*)
AGENCY 1 1 EMPLOYEE DELETED 3-NOV-16 1
AGENCY 1 1 EXCEPTION 3-NOV-16 0

I would like to remove any form IF the form returned twice where the first is any type_description and the second entry is 'exception'.

IF only one row exists and is only 'exception' I want to keep that record, but if two rows exist for the same agency, same form but 'exception' "and some other" type_description are listed, I want to omit the 'exception' from being displayed. In other words, in the above example, I'm would like ONLY the employee row to be displayed and remove the exception row. In the above example; however, if the exception were the only row, I would want to keep it.

Could someone help shed light on how I would complete this type of process? Advanced Filters, Removing Duplicates and nothing else works because althogh to me they are duplicate records (same form just different type_descriptions), Excel doesn't see them as duplicates.

Thanks,
 
Last edited:

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,527
I have coded this below. It works on a sample file that I made from your headings.

Test it (NOT on your masterfile).

Read the comments in the code, particularly those with <<< or >>> because you may need to adjust something here.

The code assumes it is run with the sheet active.

As the code is, it will not delete anything, but highlight those rows that would be deleted.
To have it in Delete mode, set the flag bDelFlag to True.

Enjoy
Code:
Option Explicit

Const bDelFlag As Boolean = False '<<< Set to False for highlighting, to True for deleting

Const iAGNCY As Integer = 1 'column A
Const iFORM As Integer = 2  'column B
Const iTYPE As Integer = 3  'column C
Const iDEF As Integer = 4   'column D


Sub FindDuplicatExeptions()
    Dim vIn As Variant, vOut As Variant, vHL As Variant
    Dim lRIn As Long, lROut As Long, lUBi As Long
    Dim lC As Long, lUBC As Long, lRChk As Long
    
    'Use arrays for very fast processing, specifically if the dataset is large
    'Read the total range into array vIn. >>> assumes range starts in A1
    vIn = Range("A1").CurrentRegion.Value
    'get the array size (number of rows)
    lUBi = UBound(vIn, 1)
    lUBC = UBound(vIn, 2)   'number of columns
    
    'set up output array and copy header row
    ReDim vOut(1 To lUBi, 1 To lUBC)
    For lC = 1 To lUBC
        vOut(1, lC) = vIn(1, lC)
    Next lC
    
    'set up array for highlighting
    If Not bDelFlag Then ReDim vHL(1 To lUBi)
    
    'Now loop through the input array. Copy the rows which do not have EXCEPTION. _
     If the row has exeption then check to see if there is a duplicate.
     lROut = 2
     For lRIn = 2 To lUBi
        If vIn(lRIn, iTYPE) = "EXCEPTION" Then
            'check to see if there is a 'duplicate' line
            For lRChk = 2 To lUBi
                If lRChk <> lRIn Then
                    If vIn(lRChk, iAGNCY) = vIn(lRIn, iAGNCY) And _
                        vIn(lRChk, iFORM) = vIn(lRIn, iFORM) And _
                        vIn(lRChk, iTYPE) <> vIn(lRIn, iTYPE) _
                        Then    'duplicate found
                        
                        'if highlight is on
                        If Not bDelFlag Then
                            vHL(lRIn) = True
                        Else
                        ' delete Exception row by not copying, ie do nothing
                        
                        End If
                    End If
                End If
            Next lRChk
        Else
            'copy row to out
            For lC = 1 To lUBC
                vOut(lROut, lC) = vIn(lRIn, lC)
            Next lC
            'increase counter for output row
            lROut = lROut + 1
        End If
    Next lRIn
     
     'Now for the output
    If bDelFlag Then 'overwrite the range with the output array
        Range("A1").CurrentRegion.Value = vOut
    Else
        'highlight
        For lRIn = 1 To lUBi
            If vHL(lRIn) Then
                Range("A1").CurrentRegion.Rows(lRIn).Interior.Color = RGB(200, 200, 10)
            End If
        Next lRIn
    End If
End Sub
 

Forum statistics

Threads
1,081,865
Messages
5,361,755
Members
400,655
Latest member
Mickey123

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top