This should do it:
Sub test()
lastrow = Cells(Rows.Count, "B").End(xlUp).Row
inarr = Range(Cells(1, 2), Cells(lastrow, 2))
Range(Cells(2, 5), Cells(lastrow, 5)) = "N/A"
outarr = Range(Cells(1, 5), Cells(lastrow, 5))
For i = 2 To lastrow
If InStr(inarr(i, 1), "Triangle") > 0 Then
outarr(i, 1) = "Triangle"
End If
If InStr(inarr(i, 1), "Square") > 0 Then
outarr(i, 1) = "Square"
End If
If InStr(inarr(i, 1), "Circle") > 0 Then
outarr(i, 1) = "Circle"
End If
Next i
Range(Cells(1, 5), Cells(lastrow, 5)) = outarr
End Sub