Clear adjacent duplicates only - excel

Question

This sub clears duplicate rows between two columns.
If it finds a new pair in columns F & G, it will clear that pair throughout F & G.
I'm trying to clear values that are directly below the original values.
I'm trying to reset after a duplicate been cleared, so that it doesn't clear values that aren't directly below the original values.
Sub clearDups1()
Dim lngMyRow As Long
Dim lngMyCol As Long
Dim lngLastRow As Long
Dim objMyUniqueData As Object
Application.ScreenUpdating = False
lngLastRow = Range("F:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
Set objMyUniqueData = CreateObject("Scripting.Dictionary")
For lngMyRow = 1 To lngLastRow 'Assumes the data starts at row 1. Change to suit if necessary.
If objMyUniqueData.Exists(CStr(Cells(lngMyRow, 6) & Cells(lngMyRow, 7))) = False Then
objMyUniqueData.Add CStr(Cells(lngMyRow, 6) & Cells(lngMyRow, 7)), Cells(lngMyRow, 6) & Cells(lngMyRow, 7)
Else
Range(Cells(lngMyRow, 6), Cells(lngMyRow, 7)).ClearContents
End If
Next lngMyRow
Set objMyUniqueData = Nothing
Application.ScreenUpdating = True
End Sub
Any input appreciated.

Answer 1

You don't need a dictionary for this:
Sub clearDups1()
Dim lngMyRow As Long, lngLastRow As Long, ws As Worksheet
Dim k As String, kPrev As String
Set ws = ActiveSheet
lngLastRow = ws.Range("F:G").Find("*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).row
Application.ScreenUpdating = False
kPrev = Chr(0) 'won't occur in your data
For lngMyRow = 1 To lngLastRow 'Assumes the data starts at row 1. Change to suit if necessary.
k = CStr(ws.Cells(lngMyRow, 6).Value) & "<>" & CStr(ws.Cells(lngMyRow, 7).Value)
If kCurr = k Then 'same as previous row?
ws.Cells(lngMyRow, 6).Resize(1, 2).ClearContents
End If
kPrev = k 'set as key for previous row
Next lngMyRow
Application.ScreenUpdating = True
End Sub

Answer 2

You can also try this code. It does what you have asked.
Leave the first occurring of the same dups
Start from the bottom to delete them and leave the final which in our case will be original
Using the above ways you can achieve what you have asked for.
Sub clearDups()
Dim lR As Long, r As Long
Dim x As 99999
Dim f(x), g(x) As String
Dim lRow As Long, lCol As Long, i As Long
lRow = Range("F" & Rows.Count).End(xlUp).Row
For lR = 2 To lRow
f(lR - 1) = Cells(lR, "F").Value
g(lR - 1) = Cells(lR, "G").Value
Next
For Each s In f
i = i + 1
If Application.CountIf(Range("F1:G" & lRow), s) = 2 Then
Cells(i, "F").Value = ""
Cells(i, "G").Value = ""
End If
Next
End Sub