VBA code to clearcontents in excel

Question

I just need help to clear the contents of the cells (L,M) if the value in Column B is blank (ie customer is the same as the previous non-blank row) and if they are duplicates in column L for each customer.

For example:

       Customer (B)             Sales (L)    Description (M)
row1   James                     Laptop     Laptop sold
row2                             Laptop     Laptop sold
row3                            Iphone      Iphone sold
row4   Brian                    Iphone      Iphone sold
row5                             Mouse      Mouse sold
row6                             Iphone     Iphone sold

Desired results:

       Customer (B)             Sales (L)    Description (M)
row1   James                     Laptop     Laptop sold
row2                             
row3                            Iphone      Iphone sold     
row4   Brian                    Iphone      Iphone sold
row5                             Mouse      Mouse sold
row6                             

Answer 1

What it seems like you want is to clear the range(E:F) where B is blank and range(E:F) is the same as the row above? If this is the case you will need something like this:

Sub Testing2()
    Dim x
    For Each c In Range(Range("E1"), Range("E" & Rows.count).End(xlUp))
        If Range("B" & c.row).Value <> "" Then
            x = 1
            Do Until Range("B" & c.row + x).Value <> "" And c.row + x < Range("E" & Rows.count).End(xlUp).row
                Range("E" & c.row).Select
                If Range("E" & c.row).Value = Range("E" & c.row + x).Value And Range("F" & c.row).Value = Range("F" & c.row + x).Value Then
                    Range("E" & c.row + x & ":F" & c.row + x).ClearContents
                End If
                If c.row + x >= Range("E" & Rows.count).End(xlUp).row Then
                    Exit Do
                End If
                x = x + 1
            Loop
        End If
        If Range("B" & c.row).Value = "" Then
            x = 1
            Do Until Range("B" & c.row + x).Value <> "" And c.row + x < Range("E" & Rows.count).End(xlUp).row
                Range("E" & c.row).Select
                If Range("E" & c.row).Value = Range("E" & c.row + x).Value And Range("F" & c.row).Value = Range("F" & c.row + x).Value Then
                    Range("E" & c.row + x & ":F" & c.row + x).ClearContents
                End If
                If c.row + x >= Range("E" & Rows.count).End(xlUp).row Then
                    Exit Do
                End If
                x = x + 1
            Loop
        End If
    Next
End Sub

This will start at the top and work it's way down looking for duplicates for each person.

Or you could delete the row with something like this:

Sub Testing2()
    Dim x
    For Each c In Range(Range("E1"), Range("E" & Rows.count).End(xlUp))
        If Range("B" & c.row).Value <> "" Then
            x = 1
            Do Until Range("B" & c.row + x).Value <> ""
                If Range("E" & c.row).Value = Range("E" & c.row + x).Value And Range("F" & c.row).Value = Range("F" & c.row + x).Value Then
                    Range("A" & c.row + x).Select
                    ActiveCell.Offset(0, 0).Rows("1:1").EntireRow.Select
                    Selection.Delete shift:=xlUp
                End If
                x = x + 1
            Loop
        End If
    Next
End Sub

Answer 2

Update after @Masoud Comments This matches the output desired

Option Explicit
Sub RemoveDuplicates()
    Dim rng As Range, c As Range, rCell As Range
    Dim temp As Range

    ' Update this to reference your sheet
    With Sheet1
        Set rng = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
    End With

    For Each rCell In rng
        Set c = Nothing
        If rCell.Offset(0, 1) = vbNullString Then
            With rCell.Offset(0, 1)
                Set temp = Range(.End(xlUp), .End(xlDown).Offset(-1, 0)).Offset(0, 3)
            End With
            Set c = temp.Find(rCell.Offset(0, 4), lookat:=xlWhole, after:=rCell.Offset(0, 4))

            If Not c Is Nothing Then
                If rCell.Offset(0, 5) = c.Offset(0, 1) And c.Row <> rCell.Row Then
                    Range(rCell.Offset(0, 4), rCell.Offset(0, 5)).ClearContents
                End If
            End If
        End If
    Next rCell
End Sub

Have a look at the below. This loops through all the rows in the sheet and if the cell in Column B is blank tries to find if it is present elsewhere in the sheet. If so it then clears the contents of that row.

I think you need to define a bit more what you consider a duplicate though. As in your question you:

• leave row3 (duplicate of row6)
• remove row2 (not a duplicate unless you ignore Customer)

So you have a break in your logic. If you're comparing customers (ie leaving Row3) then only row6 should end up being removed. However, if you aren't comparing customers as well as part of the duplicates then row3 should also be removed from the desired results.

Option Explicit
Public Sub RemoveDuplicates()
    Dim rng As Range, c As Range, rCell As Range

    ' Update this to reference your sheet
    With Sheet1
        Set rng = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
    End With

    For Each rCell In rng
        Set c = Nothing
        If rCell.Offset(0, 1) = vbNullString Then
            Set c = rng.Offset(0, 4).Find(rCell.Offset(0, 4), lookat:=xlWhole, after:=rCell.Offset(0, 4))

            If Not c Is Nothing Then
                '' If not including customer in comparison
                If rCell.Offset(0, 5) = c.Offset(0, 1) And c.Row <> rCell.Row Then
                '' Uncomment below and comment above if comparing customers as well
                'If rCell.Offset(0, 5) = c.Offset(0, 1) And rCell.Offset(0, 1).Value = c.Offset(0, -3).Value And c.Row <> rCell.Row Then

                    Range(rCell.Offset(0, 4), rCell.Offset(0, 5)).ClearContents
                End If
            End If
        End If
    Next rCell
End Sub

Answer 3

If you don't want to loop over the cells, you may try something like below...

Sub ClearDuplicateItems()
    Dim lr As Long
    Application.ScreenUpdating = True
    lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Columns("G:H").Insert
    Range("G2:G" & lr).Formula = "=INDEX(B$2:B2,MATCH(""zzz"",B$2:B2))"
    Range("H2:H" & lr).Formula = "=IF(COUNTIFS(G$2:G2,INDEX(B$2:B2,MATCH(""zzz"",B$2:B2)),E$2:E2,E2)>1,NA(),"""")"
    On Error Resume Next
    Range("H2:H" & lr).SpecialCells(xlCellTypeFormulas, 16).Offset(0, -2).ClearContents
    Range("H2:H" & lr).SpecialCells(xlCellTypeFormulas, 16).Offset(0, -3).ClearContents
    Columns("G:H").Delete
    Application.ScreenUpdating = True
End Sub