Copying an entry from a list into a table in Excel VBA

Question

I have a large list containing Personnel Names, Certification Names, and Certification Expiry Dates.

I am trying to write a script to copy the Certification Expiry Date for each entry into a table that has Personnel Names on one axis and Certification Names on the other axis.

The script needs to identify which cell in the table is the correct cell for each entry based on the Certification Name and Personnel Name, then copy the Certification Expiry Date into that cell.

I have written out step by step what needs to happen but am new to VBA so struggling to make it work.

Answer 1

You don't need a macro to do it. Just use a pivot table:

If you really need VBA code (not very elegant, will submit it to CodeReview for improvement suggestions):

Sub PivotData()

    Dim rng As Range, cll As Range
    Dim arr As New Collection, a
    Dim var() As Variant
    Dim l As Long
    Dim lRow As Long, lCol As Long

    l = 1

    Set rng = Range("A2:C7")

    ' Create unique list of names
    var = Range("A2:A7")
    On Error Resume Next
    For Each a In var
        arr.Add a, a

    Next
    For l = 1 To arr.Count
        Cells(l + 1, 5) = arr(l)
    Next
    Set arr = Nothing

    ' Create unique list of certificates
    var = Range("B2:B7")
    For Each a In var
        arr.Add a, a
    Next
    For l = 1 To arr.Count
        Cells(1, 5 + l) = arr(l)
    Next
    Set arr = Nothing
    On Error GoTo 0

    Range("F2").FormulaArray = _
        "=IFERROR(INDEX(R2C3:R7C3,MATCH(1,((R2C1:R7C1=RC5)*(R2C2:R7C2=R1C)),0)),"""")"

    With Range("F2")
        lRow = .CurrentRegion.Rows.Count
        lCol = .CurrentRegion.Columns.Count + 4
    End With

    Range("F2:F" & lRow).FillDown
    Range(Cells(2, 6), Cells(lRow, lCol)).FillRight

End Sub