Hi Dan,

You'll still need that formula in C9006:

Sub AppendCodes(): Dim wd As Worksheet, Code As String, F As String 'DWilkinson
Dim i As Long, j As Long, k, r As Long, er As Long, n As Long, Key As String
        Set wd = Sheets("Debtors")
er = wd.Range("A" & Rows.Count).End(xlUp).Row - 1
r = wd.Range("A:A").Find("Customer").Row + 1
    With CreateObject("Scripting.Dictionary")
        For i = 2 To 8000: Code = wd.Cells(i, 1)
                    If Not .Exists(Code) And Code <> "" Then
                .Item(Code) = i: End If
        Next i: k = .Keys(): n = .Count
        
BubbleK:
                    For i = LBound(k) To UBound(k) - 1
                    If k(i) > k(i + 1) Then
                Key = k(i): k(i) = k(i + 1): k(i + 1) = Key
                    GoTo BubbleK: End If: Next i

            If er - r > .Count Then
wd.Range("A" & r).Resize(er - r - .Count + 1, 1).EntireRow.Delete Shift:=xlUp
                    er = r + .Count - 1: End If
            If er - r < .Count - 1 Then
wd.Range("A" & er).Resize(r + .Count - er - 1, 1).EntireRow.Insert: End If

wd.Range("A" & r).Resize(.Count, 1).Value = WorksheetFunction.Transpose(k)
F = Cells(r, 3).Formula: Cells(r, 3).Copy
Range(Cells(r, 3), Cells(r + UBound(k), 32)).PasteSpecial xlPasteFormulas
        For i = r To r + UBound(k): Code = wd.Cells(i, 1)
        wd.Cells(i, 2) = wd.Cells(.Item(Code), 2): Next i
Calculate

    End With: End Sub