VBA Code to Extract data

Sub aaa()
Dim NoDupes As New Collection, tbl()
Dim a&, c&, i&, x&

a = Cells(Rows.Count, 1).End(xlUp).Row
c = Cells(Rows.Count, 3).End(xlUp).Row

For i = 2 To a
   On Error Resume Next
   If Application.CountIf(Range("C2:C" & c), Cells(i, 1).Value) = 0 Then
   NoDupes.Add 1, CStr(Cells(i, 1).Value)
   If Err.Number = 0 Then
     x = x + 1
     ReDim Preserve tbl(1 To x)
     tbl(x) = Cells(i, 1).Value
   End If
   End If
Next i

Cells(2, 5).Resize(UBound(tbl)) = Application.Transpose(tbl)
End Sub

Sub d()  Dim c01 As Range, c02, rng, rng1, lr, lr1, iRow, cel, lr2
   Application.ScreenUpdating = 0
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    lr1 = Cells(Rows.Count, 3).End(xlUp).Row
    lr2 = Cells(Rows.Count, 5).End(xlUp).Row + 1
      If lr > lr1 Then
        cel = lr
      Else
        cel = lr1
      End If
    iRow = lr2
     For i = 2 To cel
      For y = 1 To 3 Step 2
        Set c01 = Cells(i, y)
         If y = 1 Then
          Set c02 = Range("C2:C" & lr1).Find(c01, , xlValues, xlWhole)
         Else
           Set c02 = Range("A2:A" & lr).Find(c01, , xlValues, xlWhole)
         End If
            If c02 Is Nothing Then
             If c01 <> vbNullString Then
              Cells(iRow, 5).Value = c01
                If y = 1 Then
                  Cells(iRow, 6).Value = Cells(1, 1).Value
                Else
                  Cells(iRow, 6).Value = Cells(1, 3).Value
                End If
              iRow = iRow + 1
             End If
            End If
      Next y
     Next i
   Application.ScreenUpdating = 1
End Sub