Removing duplicate visible lines
I am trying to use the following VBA code to do two things.
- Count the number of unique visible rows in the filtered sheet.
- Remove duplicate lines
Still:
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 is good and if I replace R.Delete
with MsgBox(R.Row)
I get the correct duplicate line number.
-
R.Delete
doing nothing. -
R.EntireRow.Delete
doing nothing -
ws.Rows(R.Row).Delete
doing nothing.
UPDATE
This does not work
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
source to share
You seem to be breaking a few rules here.
-
You cannot use a function to delete lines in VBA. It doesn't matter if you use this function as a user-defined function (aka UDF) on a worksheet or call it from a subroutine in a VBA project. The function is meant to return a value, not to perform operations that change the structure (or even values other than its own cell) on the worksheet. In your case, it can return an array of line numbers to be removed by the child.
-
Canonical practice is believed to start at the bottom (or to the right of the columns) and work when deleting rows. Working from top to bottom can skip lines when a line is removed and you move on to the next.
Here is an example where a sub-call calls a function to collect a count of unique visible records and an array of strings to be deleted.
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 this is probably not how I would do it. It seems to be easiest to write it all in one sub. However, understanding the processes and constraints is important, so I hope you can handle it.
Please note that there is no error control in this. This must be present when working with arrays and deleting strings in loops.
source to share