Sub mukjizat2()
    Dim desc As String
    Dim sapnbr As Variant
    Dim shortDesc As String


    X = 1
    i = 2

    desc = Worksheets("process").Cells(i, 3).Value
    sapnbr = Worksheets("process").Cells(i, 1).Value
    shortDesc = Worksheets("process").Cells(i, 2).Value
    Do While Worksheets("process").Cells(i, 1).Value <> ""

    If desc = Worksheets("process").Cells(i + 1, 3).Value <> Worksheets("process").Cells(i, 3) Or Worksheets("process").Cells(i + 1, 2) <> Worksheets("process").Cells(i, 2) Then
    Delete.EntireRow
    Else
    Worksheets("output").celss(i + 1, 3).Value = desc
    Worksheets("output").Cells(i + 1, 1).Value = sapnbr
    Worksheets("output").Cells(i + 1, 2).Value = shortDesc
    X = X + 1
    End If
    i = i + 1

    Loop


    End Sub

before :

sapnbr | ShortDesc | Desc
11     | black hat | black cowboy hat vintage
12     | sunglasses| black sunglasses
13     | Cowboy hat| black cowboy hat vintage
14     | helmet 46 | legendary helmet
15     | v mask    | vandeta mask
16     | helmet 46 | valentino rossi' helmet replica

sapnbr | ShortDesc | Desc
11     | black hat | black cowboy hat vintage
13     | Cowboy hat| black cowboy hat vintage
14     | helmet 46 | legendary helmet
16     | helmet 46 | valentino rossi' helmet replica

Option Explicit

Sub mukjizat2()
    Dim ws As Worksheet
    Dim i As Long, lRow As Long
    Dim delRange As Range

    '~~> This is your sheet
    Set ws = ThisWorkbook.Sheets("process")

    With ws
        '~~> Get the last row which has data in Col A
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Loop through the rows
        For i = 2 To lRow
            '~~> For for multiple occurances
            If .Cells(i, 2).Value <> "" And .Cells(i, 3).Value <> "" Then
                If Application.WorksheetFunction.CountIf(.Columns(2), .Cells(i, 2)) = 1 And _
                Application.WorksheetFunction.CountIf(.Columns(3), .Cells(i, 3)) = 1 Then
                    '~~> Store thee row in a temp range
                    If delRange Is Nothing Then
                        Set delRange = .Rows(i)
                    Else
                        Set delRange = Union(delRange, .Rows(i))
                    End If
                End If
            End If
        Next
    End With

    '~~> Delete the range
    If Not delRange Is Nothing Then delRange.Delete
End Sub

Sub hallelujah()

    Dim duplicate(), i As Long
    Dim delrange As Range, cell As Long
    Dim delrange2 As Range

    x = 2

    Set delrange = Range("b1:b30000")
   Set delrange2 = Range("c1:c30000")

    For cell = 1 To delrange.Cells.Count
        If Application.CountIf(delrange, delrange(cell)) > 1 Then
            ReDim Preserve duplicate(i)
            duplicate(i) = delrange(cell).Address
            i = i + 1
        End If
    Next
    For cell = 1 To delrange2.Cells.Count
    If Application.CountIf(delrange2, delrange2(cell)) > 1 Then
    ReDim Preserve duplicate(i)
    duplicate(i) = delrange(cell).Address
    i = i + 1
    End If
   Next

    For i = UBound(duplicate) To LBound(duplicate) Step -1
        Range(duplicate(i)).EntireRow.Cut
        Sheets("output").Select
        Cells(x, 1).Select
        ActiveSheet.Paste
        Sheets("process").Select
        x = x + 1
    Next i
end sub