VBA to put amounts in columns based on Code in column C.

Need sheet VBA that when a code is put in column C, the amount beside it in column B is put in a column D thru U of the same row based on the code on row 4 of each column.

In other words, when the code is put in column C, VBA puts the amount in the same row, column B in the same column whose code is in row 4, for example:

_|__B__|__C_|__D_|__E__|__F__|__G__|__H__|__I__|__J__|__K__|, etc
4|_Amt_|Code|611_|_648_|_694_|_851_|_862_|_884_|_885_|_886_|, etc
5|22.01 862_________________________22.01
6|23.32 851___________________23.32
7|-4.88 611_-4.88
8|66.38 885_____________________________________66.38
9|-4.50 694______________-4.50
etc

Thank you for all your help. mikeburg

If you put this in the code module for the sheet in question, it should do what you want. Changing a cell in either column B or C will cause the value in B to be put in the column that matches the column C entry. It does nothing if the entry in C has no match in D4:U4.

If you want to auto-adjust when the headers (D4:U4) are changed, remove the marked Exit Sub line midway through the code.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim cIndex As Variant, rindex As Long
    If Target.Cells.Count = 1 Then

        If Not (Application.Intersect(Target, Range("b2:c22")) Is Nothing) Then
            With Target.EntireRow
                cIndex = Application.Match(.Range("c1").Value, .Parent.Rows(4), 0)
                If IsNumeric(cIndex) Then
                    .Range("D1:U1").ClearContents
                    .Parent.Cells(.Row, cIndex).Value = .Range("b1").Value
                End If
            End With
        End If

Exit Sub: Rem remove for header trigger

        If Not (Application.Intersect(Target, Range("D4:U4")) Is Nothing) Then
            With Target.Parent.Range("c1:c22")
                cIndex = Application.Transpose(.Value)
                .ClearContents
                For rindex = 1 To 22
                    .Cells(rindex, 1).Value = cIndex(rindex)
                Next rindex
            End With
        End If

    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim cIndex As Variant, rindex As Long
    If Target.Cells.Count = 1 Then

        If Not (Application.Intersect(Target, Range("b2:c22")) Is Nothing) Then
            With Target.EntireRow
                .Range("D1:U1").ClearContents
                cIndex = Application.Match(.Range("c1").Value, .Parent.Rows(4), 0)
                If IsNumeric(cIndex) Then
                    .Parent.Cells(.Row, cIndex).Value = .Range("b1").Value
                Else
                    MsgBox "Invalid Code"
                End If
            End With
        End If
    End If
End Sub