Hi ET,

Welcome to the board.

The following code should help get you started. It sorts the data by reference to column D, uses the Advanced Filter to get a list of the unique contract numbers, and then loops through these unique items opening/creating the workbooks as required. I haven't actually done anything with the opened workbooks yet as I'm not entirely sure what your aim is here - perhaps you could clarify. Alternatively, you may feel able to finish up from here - if so, please let us know.

Sub Test()
    Dim wsData As Worksheet
    Dim rngContracts As Range, rngUnique As Range, rngCell As Range
    Dim strFName As String
    Dim wbkContract As Workbook
    Const strDir As String = "C:\Contracts\"
Set wsData = ThisWorkbook.Worksheets("Time Data")
    'establish a reference to the data sheet
Application.ScreenUpdating = False
With wsData
.Columns("A:H").Sort _
            Key1:=Range("D2"), Order1:=xlDescending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
        'sort the data
Set rngContracts = .Range("D1:D" & .Cells(Rows.Count, "D").End(xlUp).Row)
        'the range containing data
        rngContracts.AdvancedFilter _
            Action:=xlFilterCopy, CopyToRange:=Range("J1"), Unique:=True
        'copy the unique entries to another range (amend "J1" to suit)
        Set rngUnique = .Range("J2:J" & .Cells(Rows.Count, "J").End(xlUp).Row)
        'the range of unique contract numbers (start from J2 to exclude header)
For Each rngCell In rngUnique
strFName = strDir & rngCell.Value & ".xls"
If FileExists(strFName) Then
                Set wbkContract = Workbooks.Open(Filename:=strFName)
            Else
                Set wbkContract = Workbooks.Add
                wbkContract.SaveAs Filename:=strFName
            End If
            'check if workbook already exists, if not then create it
'do stuff with wbkContract
wbkContract.Close savechanges:=True
            'close the contract workbook (saving changes)
Next rngCell
        'loop through each contract
End With
Application.ScreenUpdating = True
End Sub

Function FileExists(strFullname As String) As Boolean
    FileExists = Dir(strFullname) <> ""
End Function
HTH