PDA

View Full Version : [SOLVED:] VBA - Remove Duplicate rows from an entire worksheet



andreys
10-07-2023, 12:57 PM
Hi everyone!

I need help with VBA removing duplicate rows.

My colleagues are exporting reports from Power BI. Then, they are combined on a single worksheet. Each report can contain various numbers of rows - hundreds or dozens of thousands. After each report's dataset, an empty row is added, and then a message row with a list of filters applied in Power BI. You can see an example of the output file as attached. This is what combined data looks like.
Eventually, I don't need those "filter messages," but removing them is relatively easy. However, removing duplicate rows presents an issue.

I have recorded a macro in Excel. When recording the macro, I selected the entire worksheet, and it worked well in the workbook where it was recorded. But when running the same macro on a different dataset, it gives an error, specifically when the number of rows is larger.


Sub RemoveDuplicates()
Cells.Select
ActiveSheet.Range("$A$1:$V$5907").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22), Header:=xlYes
End Sub

Can you help me with the code that would remove duplicate rows from an entire worksheet without specifying the number of rows?

Thank you!!!
P.S. I am using Excel 365 for Windows, build 2307

Paul_Hossler
10-07-2023, 06:16 PM
Probably something like this



Option Explicit


Sub RemoveDuplicates_1()
Dim r1 As Range, r2 As Range, r As Range


With ActiveSheet
Set r1 = .Cells(2, 1)
Set r2 = .Cells(.Rows.Count, 1).End(xlUp)
Set r = Range(r1, r2)

On Error Resume Next
r.SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Delete
r.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

.Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22), Header:=xlYes
End With

End Sub

Aussiebear
10-07-2023, 08:03 PM
Welcome to VBAX Andreys.

andreys
10-09-2023, 07:55 AM
I have found a solution:

Sub RemoveDuplicates()
Dim ws As Worksheet
Dim rng As Range
Dim n As Long
Dim i As Long
Set ws = ActiveSheet
Set rng = ws.UsedRange
n = rng.Columns.Count
ReDim varArray(0 To n - 1)
For i = 0 To n - 1
varArray(i) = i + 1
Next i
ws.UsedRange.RemoveDuplicates Columns:=(varArray), Header:=xlYes
End Sub