Error

[ArbiterWolf]

Sub ExtractUniqueNames()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim dict As Object
Dim pasteRange As Range
Set ws = ThisWorkbook.Sheets("Data")
Set rng = ws.Range("E1:E" & ws.Range("E" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants)
Set dict = CreateObject("Scripting.Dictionary")
Set pasteRange = ThisWorkbook.Sheets("SummaryPage").Range("B14:B31") 'set the range where you want to paste the unique names

For Each cell In rng
If cell.Value <> "N/A" And Not dict.Exists(cell.Value) And InStr(1, cell.Value, "inserts", vbTextCompare) = 0 Then
dict.Add cell.Value, cell.Value
End If
Next cell

pasteRange.Resize(dict.Count).Value = Application.Transpose(dict.Keys()) 'paste the unique names in the paste range
End Sub


I get a Run Time error Mismatch Type Error and it highlights the pasteRange.Resize(dict.Count).Value = Application.Transpose(dict.Keys()) line

 

[DanteAmor]

That's because there is no matching data.
Replace this line:
pasteRange.Resize(dict.Count).Value = Application.Transpose(dict.Keys()) 'paste the unique names in the paste range

By these lines:

  If dict.Count > 0 Then
    pasteRange.Resize(dict.Count).Value = Application.Transpose(dict.Keys) 'paste the unique names in the paste range
  Else
    MsgBox "No data"
  End If