Sub EE_RemoveDupes(rngData As range, Optional strHeadingName As String = "")
'- takes a range
'- heading name
'- removes duplicate rows from that heading

    Dim rngSortCol As range
    Dim arr As New Collection
    Dim aFirstArray() As Variant
    Dim intRow As Long
    Dim intCol As Long
    Dim intCol2 As Long
    Dim strConc As String
 
    Dim intHeadingCol As Integer
 
'http://excelexperts.com/xla-routines-eeRemoveDupes    for updates on this sub routine

    If strHeadingName <> vbNullString Then
        intHeadingCol = Application.WorksheetFunction.Match(strHeadingName, rngData.Rows(1), 0)
    End If
 
    aFirstArray() = Application.Transpose(Application.Transpose(rngData))
 
    For intRow = LBound(aFirstArray, 1) To UBound(aFirstArray, 1)
        strConc = ""
        For intCol = LBound(aFirstArray, 2) To UBound(aFirstArray, 2)
            If strHeadingName = vbNullString Then
                strConc = strConc & aFirstArray(intRow, intCol)
            Else
                If intCol = intHeadingCol Then
                    strConc = strConc & aFirstArray(intRow, intCol)
                End If
            End If
        Next intCol
        On Error Resume Next
        arr.Add strConc, strConc
        If Err.Number <> 0 Then
            For intCol2 = LBound(aFirstArray, 2) To UBound(aFirstArray, 2)
                aFirstArray(intRow, intCol2) = ""
            Next intCol2
        End If
        On Error GoTo 0
    Next intRow
 
    rngData.value = aFirstArray
 
    With rngData
        Set rngSortCol = Intersect(.Columns(1), .Columns(1).Offset(1))
    End With
 
    With rngData.Parent.Sort
        .SortFields.Clear
        .SortFields.Add Key:=rngSortCol, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange rngData
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    Set rngSortCol = Nothing
End Sub