XLA routines: EE_RemoveDupes

Removing duplicates from a range is something you frequently want to do. EE_RemoveDupes
allows you to do this
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
»
- Nick's blog
- Login or register to post comments
- 3065 reads
Recent comments
5 years 50 weeks ago
6 years 36 weeks ago
6 years 47 weeks ago
6 years 50 weeks ago
6 years 51 weeks ago
7 years 5 weeks ago
7 years 13 weeks ago
7 years 13 weeks ago
7 years 13 weeks ago
7 years 13 weeks ago