Finding differences in semi-large, evolving dataset

datallama I've written this macro. It gives you a new worksheet with

all data, filtered for changes. Start the macro with a cell in your source data selected:

Option Explicit

Sub OutputDifferences()
    Dim src As Range
    Dim rowCt As Long
    Dim colCt As Long
    Dim data As Variant
    Dim modifiedData() As Variant
    Dim curId As String
    Const IDCol As Long = 1
    Const dateCol As Long = 2

    On Error Resume Next
    Set src=Application.InputBox("Please select the data area", "Data for update analysis", ActiveCell.CurrentRegion.Address(False, False), , , , , 8)
    If src Is Nothing Then Exit Sub
    src.Parent.Sort.SortFields.Clear
    src.Parent.Sort.SortFields.Add2 Key:=Intersect(src, src.Parent.Range("A:A")) _
                                         , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    src.Parent.Sort.SortFields.Add2 Key:=Intersect(src, src.Parent.Range("B:B")) _
                                         , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With src.Parent.Sort
        .SetRange Range("A1:R13")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    data = src.Value2
    ReDim modifiedData(LBound(data, 1) To UBound(data, 1), LBound(data, 2) To UBound(data, 2))
    For colCt = LBound(data, 2) To UBound(data, 2)
        modifiedData(1, colCt) = data(1, colCt)
        If colCt < 3 Then
            For rowCt = LBound(data, 1) + 1 To UBound(data, 1)
                modifiedData(rowCt, colCt) = data(rowCt, colCt)
            Next
        End If
    Next
    For rowCt = LBound(data, 1) + 1 To UBound(data, 1)
        If rowCt = 2 Then
            curId = data(rowCt, 1)
        Else
            If curId = data(rowCt, 1) Then
                modifiedData(rowCt, 3) = data(rowCt, 3)
                modifiedData(rowCt, 4) = data(rowCt, 4)
                modifiedData(rowCt, 5) = data(rowCt, 5)
                For colCt = LBound(data, 2) + 2 To UBound(data, 2)
                    'record fullname, first name and last name
                    'detect changes in all but the first two columns
                    If data(rowCt, colCt) <> data(rowCt - 1, colCt) Then
                        'Found a difference, write to array of differences
                        modifiedData(rowCt, colCt) = data(rowCt, colCt) & " --> " & data(rowCt - 1, colCt)
                    End If
                Next
            Else
                curId = data(rowCt, 1)
            End If
        End If
    Next
    With Worksheets.Add
        With .Range("A1").Resize(UBound(data, 1), UBound(data, 2))
            .Value = modifiedData
            With .Offset(, UBound(data, 2)).Resize(, 1)
                .FormulaR1C1 = "=COUNTIF(RC[-" & UBound(data, 2) - 2 & "]:RC[-1],""* --> *"")"
                .Cells(1, 1).Value = "Changes"
            End With
            src.Copy
            .CurrentRegion.PasteSpecial xlPasteFormats
            .CurrentRegion.PasteSpecial xlPasteColumnWidths
            .CurrentRegion.AutoFilter UBound(data, 2) + 1, ">0"

        End With
    End With
End Sub