Sub Presale()

    On Error GoTo ErrorHandler

    Dim app As New Excel.Application
    Dim wrkbkExtract As Workbook
    Dim wrkSheetMaster As Worksheet, wrkSheetExtract As Worksheet
    Dim arrSource() As Variant, arrDestination() As Variant
    Dim objFSO As Object, objFolder As Object

    app.Visible = False

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(ThisWorkbook.Path)

    For Each objFile In objFolder.Files
        If (Right(objFile.Name, 4) = ".xls" And Left(objFile.Name, 4) = "NYC_" And objFile.DateCreated > newestDateCreated) Then
            newestFilePath = objFile
            newestFilePathName = objFile.Name
            newestDateCreated = objFile.DateCreated
        End If
    Next

    If (newestFilePath = Empty) Then
        Err.Raise (0)
    End If

    Set wrkbkExtract = app.Workbooks.Open(newestFilePath)
    Set wrkSheetExtract = wrkbkExtract.Sheets(Left(newestFilePathName, Len(newestFilePathName) - 4))
    Set wrkSheetMaster = ThisWorkbook.Sheets("Master")

    lastRow = wrkSheetExtract.UsedRange.Rows.Count

    ReDim arrSource(1 To lastRow - 2, 1 To 89)
    ReDim arrDestination(1 To lastRow - 2, 1 To 28)

    arrSource = wrkSheetExtract.Range("A3:CK" & lastRow)

    aSource = Array("AP", "AQ", "I", "B", "Y", "Z", "H", "CI", "CJ", "CH", "AE", "AI", "AL", "AM")
    aDestination = Array("A", "B", "C", "D", "E", "F", "G", "T", "U", "V", "W", "AB", "Z", "AA")

    If (UBound(aSource) <> UBound(aDestination)) Then
        Err.Raise (0)
    End If

    lotColumn = ColumnToInteger("AQ")
    k = LBound(arrDestination, 1)

    Dim letterSource As String, letterDestination As String
    For i = LBound(arrSource, 1) To UBound(arrSource, 1)

        lot1 = arrSource(i, lotColumn)

        lotExists = False
        For j = i + 1 To UBound(arrSource, 1)
            lot2 = arrSource(j, lotColumn)
            If (lot1 = lot2) Then
                lotExists = True
                Exit For
            End If
        Next j

        If Not lotExists Then

            For j = LBound(aSource) To UBound(aSource)
                letterSource = aSource(j)
                letterDestination = aDestination(j)
                thisSource = ColumnToInteger(letterSource)
                thisDestination = ColumnToInteger(letterDestination)

                If (letterDestination = "U") Then
                    arrDestination(k, thisDestination) = Trim(arrSource(i, thisSource))
                Else
                    arrDestination(k, thisDestination) = arrSource(i, thisSource)
                End If
            Next j

            k = k + 1
        End If
    Next i

    wrkSheetMaster.Range("A2").Resize(UBound(arrDestination, 1), UBound(arrDestination, 2)).Value = arrDestination

ErrorHandler:

    If Not (wrkbkExtract Is Nothing) Then
        wrkbkExtract.Close SaveChanges:=False
    End If
    Set wrkSheetMaster = Nothing
    Set wrkSheetExtract = Nothing
    Set wrkbkExtract = Nothing
    Set app = Nothing
    Set objFSO = Nothing
    Set objFolder = Nothing

End Sub