VBA Remove only one duplicate value-CodePudding

First time poster here, please be patient.. :)

I am trying to find a way to compare the value in Sheet "TransferUt" Cell A1 with range A in sheet "Inne", and I only want to clear contents of the first occurence in cell A and B (Sheet "Inne") every time i run the macro. The thing is, there will be a number of duplicates in and single values in "Inne". And that is ok.

I have found and edited the following code (only the bit i have a problem with), but when i run it, it removes all duplicated values in "Inne", column A, that matches cell A1 in Sheet "TransferUt", and i only want to remove one at the time.

Dim LastRowInRange  As Long, RowCounter As Long
LastRowInRange = Sheets("Inne").Range("A:A").Find("*", , xlFormulas, , xlByRows, xlPrevious).Row

For RowCounter = LastRowInRange To 1 Step -1
    If Sheets("Inne").Range("A" & RowCounter) = Sheets("TransferUt").Range("A1") Then
        Sheets("Inne").Rows(RowCounter).Cells(2).ClearContents
        Sheets("Inne").Rows(RowCounter).Cells(1).ClearContents
End If
Next

CodePudding user response：

Sub test()
Dim ThisRow As Long

With Application.WorksheetFunction
    'first, check if value from TransferUt.A1 exist in Inne column A
    If .CountIf(ThisWorkbook.Worksheets("Inne").Range("A:A"), ThisWorkbook.Worksheets("TransferUt").Range("A1")) > 1 Then
        'If it exists then clear only the first occurrence
        ThisRow = .Match(ThisWorkbook.Worksheets("TransferUt").Range("A1"), ThisWorkbook.Worksheets("Inne").Range("A:A"), 0)
        ThisWorkbook.Worksheets("Inne").Range("A" & ThisRow & ":B" & ThisRow).ClearContents 'delete cell contents
    End If
End With

End Sub

The code first will check if your target value exists duplicated in Inne doing a count. If the count is 0 or 1 it means it does not exist or it's a single value (no duplicates in column A). If the count is more than 1, then clear the contents of the cells A and B in Inne

Note that clearing contents won't delete the row, it just leave both cells blank.

CodePudding user response：

I made it work with this piece of code:

Sub Remove_Duplicates()
Dim C As Range
Dim Endr As Range
Dim Fullr As Range
Set Endr = Range("A1").End(xlDown)
Set Fullr = Range("A1", Endr)

For Each C In Fullr:
  If WorksheetFunction.CountIf(Fullr, C.Value) > 1 Then
     C.ClearContents
  End If
Next

End Sub

So, as you can see:

Endr is the last cell of column "A" which contains a value.
Fullr is the entire range of column "A" which contains values.

You run over the entire Fullr and for each cell, you count the amount of times its value appears in column "A" and when it appears more than one time, the value gets deleted. Like that, the value of CountIf() will reduce until only single values are left.