Date compare and update with the latest record

Sub Getlast_po_date_only()

Dim i, j, k, cs, sb As Integer

Dim ll, pl As String

Dim st, dd(16000) As Date

Dim got As Boolean

Const max = 2152

st = Time

j = 1

dd(1) = "30/9/2011"

For i = 2 To max

ll = Worksheets(1).Cells(i, 2).Value & Worksheets(1).Cells(i, 4).Value

k = 1: got = False

    Do While k < j + 1

    pl = Worksheets(2).Cells(k, 2).Value & Worksheets(2).Cells(k, 4).Value

    'If Mid$(pl, 1, Len(pl) - 2) = Mid$(ll, 1, Len(ll) - 2) Then

    If pl = ll Then

        got = True:    cs = cs + 1

        If Worksheets(1).Cells(i, 3).Value > dd(k) Then

        sb = sb + 1

        Worksheets(2).Cells(k, 1) = Worksheets(1).Cells(i, 1).Value

        Worksheets(2).Cells(k, 2) = Worksheets(1).Cells(i, 2).Value

        'Worksheets(2).Cells(k, 3) = "'" & Worksheets(1).Cells(i, 3).Value

        dd(k) = Worksheets(1).Cells(i, 3).Value

        Worksheets(2).Cells(k, 4) = Worksheets(1).Cells(i, 4).Value

        Worksheets(2).Cells(k, 5) = Worksheets(1).Cells(i, 5).Value

        Worksheets(2).Cells(k, 6) = Worksheets(1).Cells(i, 6).Value

        Worksheets(2).Cells(k, 7) = Worksheets(1).Cells(i, 7).Value

       

        End If

    Exit Do

    End If

    k = k + 1

    Loop

   

    If Not got Then

    j = j + 1

    Worksheets(2).Cells(j, 1) = Worksheets(1).Cells(i, 1).Value

    Worksheets(2).Cells(j, 2) = Worksheets(1).Cells(i, 2).Value

    'Worksheets(2).Cells(j, 3) = "'" & Worksheets(1).Cells(i, 3).Value

    dd(j) = Worksheets(1).Cells(i, 3).Value

    Worksheets(2).Cells(j, 4) = Worksheets(1).Cells(i, 4).Value

    Worksheets(2).Cells(j, 5) = Worksheets(1).Cells(i, 5).Value

    Worksheets(2).Cells(j, 6) = Worksheets(1).Cells(i, 6).Value

    Worksheets(2).Cells(j, 7) = Worksheets(1).Cells(i, 7).Value

    End If

Next i

For i = 1 To 4700

Worksheets(2).Cells(i, 3) = dd(i)

Next

MsgBox "Start time : " & st & vbCrLf & "End time   : " & Time

MsgBox " CS : " & cs & vbCrLf & " SB : " & sb

End Sub