Remove Duplicate Rows i.e. Hide or Delete
- The 1st Sub shows how to use the 2nd, main sub (
removeDuplicateRows).
- The remaining Subs are being called be the main sub (also necessary).
- Only when done testing, go from hiding to deleting.
The Code
Option Explicit
Sub testRemoveDuplicateRows()
Const wsName As String = "Sheet1"
Const LastRowColumnID As Variant = "A" ' e.g. 1 or "A"
Const FirstRow As Long = 2
Dim ColumnIDs As Variant: ColumnIDs = Array(1, "M")
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
' Hide duplicate rows.
removeDuplicateRows ws, ColumnIDs, LastRowColumnID, FirstRow, True
' Delete duplicate rows.
'removeDuplicateRows ws, ColumnIDs, LastRowColumnID, FirstRow
End Sub
Sub removeDuplicateRows(Sheet As Worksheet, _
ColumnIDs As Variant, _
Optional LastRowColumnID As Variant = 1, _
Optional FirstRow As Long = 1, _
Optional hideOnly As Boolean = False)
' Write values of columns to jagged array.
Dim Cols As Variant
getColumns Cols, Sheet, ColumnIDs, LastRowColumnID, FirstRow
' Join values of arrays in jagged array.
Dim Data As Variant: joinColumns Data, Cols
' Write duplicate row numbers to array.
Dim RowOffset As Long: RowOffset = FirstRow - 1 ' 1 = ubound(Data)
Dim DupeRows As Variant
collectDuplicateRows DupeRows, Data, RowOffset
' Hide or delete duplicate rows.
If hideOnly Then
hideRows Sheet, DupeRows
Else
deleteRows Sheet, DupeRows
End If
End Sub
Sub getColumns(ByRef Data As Variant, _
Sheet As Worksheet, _
ColumnIDs As Variant, _
Optional LastRowColumnID As Variant = 1, _
Optional FirstRow As Long = 1)
Dim ubc As Long: ubc = UBound(ColumnIDs)
If ubc = -1 Then Exit Sub
Dim rng As Range: getColumnRange rng, Sheet, LastRowColumnID, FirstRow
If rng Is Nothing Then Exit Sub
ReDim Data(ubc): getColumnFromColumnRange Data(0), rng
If ubc > 0 Then GoSub getRemainingColumns
Exit Sub
getRemainingColumns:
Dim j As Long
For j = 1 To ubc
getColumnFromColumnRange Data(j), _
rng.Offset(, Sheet.Columns(ColumnIDs(j)).Column - rng.Column)
Next j
Return
End Sub
Sub getColumnRange(ByRef ColumnRange As Range, _
Sheet As Worksheet, _
Optional ColumnID As Variant = 1, _
Optional FirstRow As Long = 1)
Set ColumnRange = Nothing
Dim rng As Range
Set rng = Sheet.Columns(ColumnID).Find("*", , xlValues, , , xlPrevious)
If rng Is Nothing Then Exit Sub
If rng.Row < FirstRow Then Exit Sub
Set ColumnRange = Sheet.Range(Sheet.Cells(FirstRow, ColumnID), rng)
End Sub
Sub getColumnFromColumnRange(ByRef Data As Variant, _
ColumnRange As Range)
If ColumnRange Is Nothing Then Exit Sub
If ColumnRange.Cells.Count > 1 Then
Data = ColumnRange.Value
Else
ReDim Data(1 To 1, 1 To 1): Data(1, 1) = ColumnRange.Value
End If
End Sub
Sub joinColumns(ByRef Data As Variant, _
ColumnsArray As Variant, _
Optional Delimiter As String = "|||")
Data = ColumnsArray(0)
If UBound(ColumnsArray) = 0 Then Exit Sub
Dim ubr As Long: ubr = UBound(Data)
Dim j As Long, i As Long
For j = 1 To UBound(ColumnsArray)
For i = 1 To ubr
Data(i, 1) = Data(i, 1) & Delimiter & ColumnsArray(j)(i, 1)
Next i
Next j
End Sub
Sub collectDuplicateRows(ByRef DupeRows As Variant, _
Data As Variant, _
Optional RowOffset As Long = 0, _
Optional DupeRowsFirstIndex As Long = 0)
Dim ub As Long: ub = UBound(Data)
If ub < 2 Then Exit Sub
Dim i As Long, k As Long, m As Long: m = DupeRowsFirstIndex - 1
ReDim DupeRows(DupeRowsFirstIndex To ub + DupeRowsFirstIndex - 2)
For i = 1 To ub - 1
For k = i + 1 To ub
If Data(k, 1) = Data(i, 1) Then
m = m + 1
DupeRows(m) = k + RowOffset
Exit For
End If
Next k
Next i
If m > DupeRowsFirstIndex - 1 Then
ReDim Preserve DupeRows(DupeRowsFirstIndex To m)
Else
DupeRows = Empty
End If
End Sub
Sub deleteRows(Sheet As Worksheet, _
RowNumbers As Variant)
Dim rng As Range: Set rng = Sheet.Rows(RowNumbers(LBound(RowNumbers)))
If UBound(RowNumbers) > LBound(RowNumbers) Then GoSub collectRemainingRows
If Not rng Is Nothing Then rng.EntireRow.Delete
Exit Sub
collectRemainingRows:
Dim j As Long
For j = LBound(RowNumbers) + 1 To UBound(RowNumbers)
Set rng = Union(rng, Sheet.Rows(RowNumbers(j)))
Next j
Return
End Sub
Sub hideRows(Sheet As Worksheet, _
RowNumbers As Variant)
Dim rng As Range: Set rng = Sheet.Rows(RowNumbers(LBound(RowNumbers)))
If UBound(RowNumbers) > LBound(RowNumbers) Then GoSub collectRemainingRows
If Not rng Is Nothing Then rng.EntireRow.Hidden = True
Exit Sub
collectRemainingRows:
Dim j As Long
For j = LBound(RowNumbers) + 1 To UBound(RowNumbers)
Set rng = Union(rng, Sheet.Rows(RowNumbers(j)))
Next j
Return
End Sub