Finding Start date and End date for value using vba

Try this:

Sub zz()
Dim d As Object, k, t, f$
Set d = CreateObject("scripting.dictionary")
f = [b2].NumberFormat
ar = [a1].CurrentRegion.Value
For i = 2 To UBound(ar)
    k = ar(i, 1)
    If Not d.exists(k) Then
        d(k) = Array(ar(i, 2), ar(i, 2), ar(i, 3))
    Else
        t = d(k)
        t(2) = t(2) + ar(i, 3)
        t(1) = IIf(t(1) > ar(i, 2), t(1), ar(i, 2))
        d(k) = t
    End If
Next
[a18].Resize(d.Count, 4).Borders.Value = 1
[a18].Resize(d.Count, 1) = Application.Transpose(d.keys)
[b18].Resize(d.Count, 2).NumberFormat = f
[b18].Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.items))
End Sub