Try the next code, please:
Sub testFirstLastOccurrences()
Dim sh As Worksheet, lastRA As Long, lastRD As Long, arrA As Variant, k As Long
Dim ArrFin As Variant, i As Long, j As Long, lngFirst As Long, lngLast As Long
Set sh = ActiveSheet
lastRA = sh.Range("A" & Rows.count).End(xlUp).Row
lastRD = sh.Range("D" & Rows.count).End(xlUp).Row
arrA = sh.Range("A2:A" & lastRA).Value
ReDim ArrFin(1 To 3, 1 To lastRD)
For i = 1 To UBound(arrA)
For j = 2 To lastRD
If lngFirst = 0 And arrA(i, 1) = sh.Range("D" & j).Value Then lngFirst = j
If arrA(i, 1) = sh.Range("D" & j).Value Then lngLast = j
Next j
If lngFirst <> 0 Then
k = k + 1
ArrFin(1, k) = arrA(i, 1): ArrFin(2, k) = lngFirst: ArrFin(3, k) = lngLast
End If
lngFirst = 0: lngLast = 0
Next i
ReDim Preserve ArrFin(1 To 3, 1 To k)
sh.Range("F1:H1").Value = Array("ARRAY()", "1st Row", "Last Row")
'Drop the processed data:
sh.Range("F2").Resize(UBound(ArrFin, 2), UBound(ArrFin, 1)).Value = _
WorksheetFunction.Transpose(ArrFin)
End Sub