I have some code that was generously provided to me that I believe is almost there for another task I need done. The below code is finding the Duplicates in A and then highlighting differences in all columns across the rows that have duplicates in Column A. I was looking to do something similar to what this code does for a follow on sub. Once the duplicates have been identified in Column A, instead just check column B from the 2 rows with duplicates in column A, if the value Initial is found in Column B, then delete the entire row. I have tried to modify this code to do this, but no luck. Any way this can be accomplished with small changes to this code?

Option Explicit

Sub Demo()
    Dim objDic As Object, rngData As Range
    Dim i As Long, sKey, diffRng As Range
    Dim rng1 As Range, rng2 As Range, arrData
    Set objDic = CreateObject("scripting.dictionary")
    Set rngData = Range("A1").CurrentRegion
    arrData = rngData.Value
    ' consolidate data with Dict object
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = arrData(i, 1)
        If objDic.exists(sKey) Then
            Set objDic(sKey) = Application.Union(objDic(sKey), Cells(i, 1))
        Else
            Set objDic(sKey) = Cells(i, 1)
        End If
    Next i
    For Each sKey In objDic.Keys
        If objDic(sKey).Cells.Count > 1 Then ' duplicated rows
            ' get the first row
            Set rng1 = Application.Intersect(rngData, objDic(sKey).Cells(1).EntireRow)
            ' get the second row
            If objDic(sKey).Areas.Count = 1 Then
                Set rng2 = Application.Intersect(rngData, objDic(sKey).Cells(2).EntireRow)
            Else
                Set rng2 = Application.Intersect(rngData, objDic(sKey).Areas(2).Cells(1).EntireRow)
            End If
            ' compare two rows
            Set diffRng = MergeRng(diffRng, GetDiff(rng1, rng2))
        End If
    Next
    ' highlight difference
    If Not diffRng Is Nothing Then
        diffRng.Interior.ColorIndex = 6
    End If
End Sub

' Copare two rows
Function GetDiff(ByRef rng1 As Range, ByRef rng2 As Range) As Range
    Dim i As Long
    For i = 1 To rng1.Cells.Count
        If rng1.Cells(i).Value <> rng2.Cells(i).Value Then
            Set GetDiff = MergeRng(GetDiff, Application.Union(rng1.Cells(i), rng2.Cells(i)))
        End If
    Next
End Function

' Merge two range
Function MergeRng(ByRef RngAll As Range, ByRef RngSub As Range) As Range
    If RngAll Is Nothing Then
        Set RngAll = RngSub
    ElseIf Not RngSub Is Nothing Then
        Set RngAll = Application.Union(RngAll, RngSub)
    End If
    Set MergeRng = RngAll
End Function