Macro to auto fill in cells based on value on different cells

Place this in the Defect detail worksheet mod

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Column = 6 Then
        Dim a
            If VBA.Trim$(.Value) <> VBA.vbNullString Then
                a = RejectCodes(Target.Value)
                .Offset(, 1) = a(1)
                .Offset(, 2) = a(0)
            End If
        End If
    End With
End Sub
Function RejectCodes(sValue As String) As Variant()
Const shLookUp As String = "Reject Codes"
Dim FoundCell As Range, i As Long
Dim aValues(1)
Set FoundCell = Worksheets(shLookUp).Range("B:B").Find(What:=sValue, LookAt:=xlWhole)

If Not FoundCell Is Nothing Then
    aValues(0) = FoundCell.Offset(, 1).Value
    If VBA.Trim$(FoundCell.Offset(, -1).Value) = VBA.vbNullString Then
        For i = FoundCell.Row To 3 Step -1
            With Worksheets(shLookUp)
                If VBA.Trim$(.Cells(i, "a").Value) <> vbNullString Then
                    aValues(1) = .Cells(i, "a").Value
                  Exit For
                End If
            End With
        Next
    Else
        aValues(1) = FoundCell.Offset(, -1).Value
    End If
    
End If
RejectCodes = aValues

End Function

small modification to clearcontents

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Column = 6 And .Cells.Count = 1 Then
        Dim a
            If VBA.Trim$(.Value) <> VBA.vbNullString Then
                a = RejectCodes(Target.Value)
                .Offset(, 1) = a(1)
                .Offset(, 2) = a(0)
            Else
                .Offset(, 1).ClearContents
                .Offset(, 2).ClearContents
            End If
        End If
    End With
End Sub
Function RejectCodes(sValue As String) As Variant()
Const shLookUp As String = "Reject Codes"
Dim FoundCell As Range, i As Long
Dim aValues(1)
Set FoundCell = Worksheets(shLookUp).Range("B:B").Find(What:=sValue, LookAt:=xlWhole)

If Not FoundCell Is Nothing Then
    aValues(0) = FoundCell.Offset(, 1).Value
    If VBA.Trim$(FoundCell.Offset(, -1).Value) = VBA.vbNullString Then
        For i = FoundCell.Row To 3 Step -1
            With Worksheets(shLookUp)
                If VBA.Trim$(.Cells(i, "a").Value) <> vbNullString Then
                    aValues(1) = .Cells(i, "a").Value
                  Exit For
                End If
            End With
        Next
    Else
        aValues(1) = FoundCell.Offset(, -1).Value
    End If
    
End If
RejectCodes = aValues

End Function