Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Deleting Duplicate Visible Rows

Tags:

excel

filter

vba

I am trying to use the following VBA code to do two things.

  1. Count the number of unique visible rows in a filtered worksheet.
  2. Delete the duplicate rows

So far:

Function UniqueVisible(MyRange As Range) As Integer


    Dim ws As Worksheet
    Set ws = Worksheets(1)

    Dim R As Range
    Dim V() As String
    ReDim V(0 To MyRange.Count) As String


    For Each R In MyRange
        If (R.EntireRow.Hidden = False) Then
            For Index = 0 To UniqueVisible
                If (V(Index) = R.Value) Then
                    R.Delete
                    Exit For
                End If

                If (Index = UniqueVisible) Then
                    V(UniqueVisible) = R.Value
                    UniqueVisible = UniqueVisible + 1
                End If
            Next
        End If
    Next R

End Function

This counts okay, and if I replace R.Delete with MsgBox(R.Row) I get the correct row number of the duplicate.

  • R.Delete does nothing.
  • R.EntireRow.Delete does nothing
  • ws.Rows(R.Row).Delete does nothing.

UPDATE

This doesn't seem to be working

Function UniqueVisible(MyRange As Range) As Integer

    Dim ws As Worksheet
    Set ws = Worksheets(1)

    Dim R As Range

    Dim Dup As Integer
    Dup = 0

    Dim Dups() As Integer
    ReDim Dups(0 To MyRange.Count) As Integer

    Dim V() As String
    ReDim V(0 To MyRange.Count) As String


    For Each R In MyRange
        If (R.EntireRow.Hidden = False) Then
            For Index = 0 To UniqueVisible
                If (V(Index) = R.Value) Then
                    Dups(Dup) = R.Row
                    Dup = Dup + 1
                    Exit For
                End If

                If (Index = UniqueVisible) Then
                    V(UniqueVisible) = R.Value
                    UniqueVisible = UniqueVisible + 1
                End If
            Next
        End If
    Next R

    For Each D In Dups
        ws.Rows(D).Delete
    Next D

End Function
like image 418
Jonathon Anderson Avatar asked Dec 09 '25 06:12

Jonathon Anderson


2 Answers

It seems you're breaking a few rules here.

  1. You cannot use a function to delete rows in VBA. It does not matter whether you are using the function as a User Defined Function (aka UDF) on the worksheet or calling it from a sub in a VBA project. A function is meant to return a value, not perform operations that modify the structure (or even the values other than its own cell) on a worksheet. In your case, it could return an array of row numbers to be deleted by a sub.

  2. It is considered canonical practise to start from the bottom (or the right for columns) and work up when deleting rows. Working from the top to the bottom may skip rows when a row is deleted and you loop to the next one.

Here is an example where a sub calls the function to gather the count of the unique, visible entries and an array of rows to be removed.

Sub remove_rows()
    Dim v As Long, vDelete_These As Variant, iUnique As Long
    Dim ws As Worksheet

    Set ws = Worksheets(1)

    vDelete_These = UniqueVisible(ws.Range("A1:A20"))

    iUnique = vDelete_These(LBound(vDelete_These))

    For v = UBound(vDelete_These) To (LBound(vDelete_These) + 1) Step -1 'not that we are working from the bottom up
        ws.Rows(vDelete_These(v)).EntireRow.Delete
    Next v

    Debug.Print "There were " & iUnique & " unique, visible values."

End Sub

Function UniqueVisible(MyRange As Range)
    Dim R As Range
    Dim uniq As Long
    Dim Dups As Variant
    Dim v As String

    ReDim Dups(1 To 1) 'make room for the unique count
    v = ChrW(8203) 'seed out string hash check with the delimiter

    For Each R In MyRange
        If Not R.EntireRow.Hidden Then
            If CBool(InStr(1, v, ChrW(8203) & R.Value & ChrW(8203), vbTextCompare)) Then
                ReDim Preserve Dups(1 To UBound(Dups) + 1)
                Dups(UBound(Dups)) = R.Row
            Else
                uniq = uniq + 1
                v = v & R.Value & ChrW(8203)
            End If
        End If
    Next R

    Dups(LBound(Dups)) = uniq  'stuff the unique count into the primary of the array

    UniqueVisible = Dups

End Function

Now, that is probably not how I would go about it. Seems easier to just write the whole thing into a single sub. However, understanding processes and limitations is important so I hope you can work with this.

Note that this does not have any error control. This should be present when dealing with arrays and deleting row in loops.

You can't delete a row while you're looping through the rows. You'll need to store the rows that need to be deleted in an array, and then loop through the array and delete the rows after it's done looping through the rows.

like image 32
Tony Hinkle Avatar answered Dec 11 '25 00:12

Tony Hinkle



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!