Simple approach (if I understood the requirements correctly)
Option Explicit
Sub PartNumbers()
Dim rData As Range
Dim i As Long
Dim sPN As String, sPN1 As String, sPN2 As String
Application.ScreenUpdating = False
Set rData = ActiveSheet.Cells(1, 1).CurrentRegion ' A1:D23
For i = 2 To rData.Rows.Count ' rows 2 - 23
sPN = rData.Cells(i, 1).Value ' C3972
sPN1 = Left(sPN, 1) ' C
sPN2 = Mid(sPN, 2, 1) ' 3
Select Case sPN1
Case "0" To "9"
rData.Cells(i, 4).Value = "Invalid Part Number"
rData.Cells(i, 4).Interior.Color = vbYellow
Case Else
Select Case sPN2
Case "0", "2", "4", "6", "8"
rData.Cells(i, 4).Value = "In-House"
Case "1", "3", "5", "7", "9"
rData.Cells(i, 4).Value = "Outsource"
End Select
End Select
Next i
Application.ScreenUpdating = True
MsgBox "Done"
End Sub