Get 1st and last addresses of cells in a range

Hi all,

If I have more than one occurrence of a word (say "Ford") in Col A (say A1, A5, A10, and A14) and I want (with VBA) to return the number of occurrences and the first and last cell addresses (ie 4 times and "A1" and "A14") can anyone point me in the right direction please?

Regards

Seamus

May have over thought these but

Dim Rng As Range, FndLast As Range
Dim FndWrd As String
Dim i As Long, LastRow As Long, WrdCnt As Long

FndWrd = "Ford"
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range("A1:A" & LastRow)

WrdCnt = WorksheetFunction.CountIf(Rng, FndWrd)

MsgBox WrdCnt

    For i = 1 To LastRow
        If Cells(i, "A").Value = FndWrd Then
            MsgBox Cells(i, "A").Address(0, 0)
        Exit For
        End If
    Next i
    
Set FndLast = Rng.Find(FndWrd, After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    
    If Not FndLast Is Nothing Then
        MsgBox FndLast.Address(0, 0)
    End If

or

Dim Rng As Range, FndFirst As Range, FndLast As Range
Dim FndWrd As String
FndWrd = "Ford"
Set Rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)

MsgBox WorksheetFunction.CountIf(Rng, FndWrd)

If Range("A1").Value = FndWrd Then
     MsgBox Range("A1").Address(0, 0)
Else
Set FndFirst = Rng.Find(What:=FndWrd)
        
    If Not FndFirst Is Nothing Then
        MsgBox FndFirst.Address(0, 0)
    End If
End If

Set FndLast = Rng.Find(FndWrd, After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    
    If Not FndLast Is Nothing Then
        MsgBox FndLast.Address(0, 0)
    End If

VBA Noob

Maybe.

Change delete to clearcontents if required

Dim FndWrd As String
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
FndWrd = "Ford"

For i = LastRow To 1 Step -1
WrdCnt = WorksheetFunction.CountIf(Range("A1:A" & LastRow), FndWrd)
    If Not WorksheetFunction.CountIf(Range("A1:A" & i), FndWrd) = WrdCnt And _
        Not WorksheetFunction.CountIf(Range("A1:A" & i), FndWrd) = 1 And _
        Cells(i, "A").Value = FndWrd Then
        Rows(i).EntireRow.Delete
    End If
Next i

VBA Noob