How about 
Sub Runner()
   Dim Dic As Object
   Dim Cl As Range
   Set pWB = ThisWorkbook
   Set wsHome = pWB.Worksheets("Home")
   Set wsText = pWB.Worksheets("Texter")
   
   'Start Loop
   wsText.Columns("C:D").ColumnWidth = 20
   wsText.Columns("C:D").HorizontalAlignment = xlCenter
   wsText.Range("$C$1").Value = "Part Number"
   wsText.Range("$D$1").Value = "Part Cost"
   
   Set Dic = CreateObject("scripting.dictionary")
   With wsText.Range("A:A")
      .Replace "Mfr", "=xxxMfr", xlWhole, , False, , False, False
      For Each Cl In .SpecialCells(xlFormulas, xlErrors)
         Dic(Trim(Cl.Offset(1, 1).Value)) = Cl.Offset(5, 1).Value
      Next Cl
      .Replace "=xxxMfr", "Mfr", xlWhole, , False, , False, False
   End With
   wsText.Range("C2").Resize(Dic.Count, 2).Value = Application.Transpose(Array(Dic.keys, Dic.items))
End Sub