0

I'm trying to delete all duplicate rows based on Column B and leave only the unique rows.

It will leave one of the duplicate entries. I tried with > 1 and = 2.

Sub test1() Dim fName As String, fPath As String, wb As Workbook, sh As Worksheet, i As Long, lCopyLastRow As Long, lDestLastRow As Long Set sh = ActiveSheet fPath = ThisWorkbook.Path & "\" fName = Dir(fPath & "*.xls*") Do If fName <> ThisWorkbook.Name Then Set wb = Workbooks.Open(fPath & fName) lCopyLastRow = wb.Sheets(1).Cells(wb.Sheets(1).Rows.Count, "A").End(xlUp).Row lDestLastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Offset(1).Row wb.Sheets(1).Range("A2:AA1000" & lCopyLastRow).Copy sh.Range("B" & lDestLastRow) sh.Range("A1") = "Source" With sh .Range(.Cells(Rows.Count, 1).End(xlUp)(2), .Cells(Rows.Count, 2).End(xlUp).Offset(, -1)) = fName End With wb.Close End If Set wb = Nothing fName = Dir Loop Until fName = "" For i = sh.UsedRange.Rows.Count To 2 Step -1 If Application.CountIf(sh.Range("B:B"), sh.Cells(i, 2).Value) > 1 Then Rows(i).Delete Next End Sub
Improve this question
5
  • You might find it's a bit easier with the native Range.RemoveDuplicates. You can specify the column to look at for dupes. learn.microsoft.com/en-us/office/vba/api/… Commented Oct 19, 2021 at 10:58
  • I've actually tried with the following code but issue still persist though Range("A2:AA10000").CurrentRegion.RemoveDuplicates Columns:=Array(2), Header:=xlYes Commented Oct 19, 2021 at 11:02
  • 2
    Please, replace Range("A2:AA1000" & lCopyLastRow).Copy with Range("A2:AA" & lCopyLastRow).Copy... Commented Oct 19, 2021 at 11:05
  • This doesn't really solve the issue, just that it select the select column AA that's about it though Commented Oct 19, 2021 at 11:12
  • So you want to keep the values that are unique in the source data and remove all data that are non-unique? Commented Oct 19, 2021 at 12:05

1 Answer 1

Reset to default
1

The problem with your code is, that you countIf on the remaining rows - if you already deleted the "other" duplicates the first one is a unique value in the then remaining list.

So you have to count the occurences before deleting.

Sub removeNonUniqueRows() Dim arrCountOccurences As Variant ReDim arrCountOccurences(2 To sh.UsedRange.Rows.Count) Dim i As Long For i = 2 To sh.UsedRange.Rows.Count arrCountOccurences(i) = Application.CountIf(sh.Range("B:B"), sh.Cells(i, 2).Value) Next For i = sh.UsedRange.Rows.Count To 2 Step -1 If arrCountOccurences(i) > 1 Then sh.Rows(i).Delete Next End Sub
Improve this answer
Sign up to request clarification or add additional context in comments.

5 Comments

Looks like a good answer. Feel free to ignore this unsolicited advice: To my eye, the abbreviation "...Cnt" is a bit unsettling. The sub name was nice and descriptive.. why not follow suit and call your array something like dupeCount? We already know it's an array by the declaration, I don't think prefixing it "arr" makes much difference :)
hmmm - with arrays I indeed always use a prefix (like e.g. with worksheets (ws) as well). But you are right - arrCountOccurences would be a better name. dupeCount is not exactly correct - as I am counting the unique ones as well ;-)
Good point. That's probably why I always end up renaming my variables 100 times, trying to get the most accurate description ... !
me too - finding good names is so essential for good code.
I would agree this answer looks good, and I agree with CallumDA!

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.