Search for keyword from prompt in Excel then create new tab with summary part 2

This question is building of the code developed by Romcel Geluz found here

• The attached code somehow creates duplicate entries in the newly created sheet with the found search text. How to have each found row entry from each sheet to appear just once when the keyword is found?
• How to also append the found row columns to the created sheet, like this:

• How to name the newly created sheet, "Summary" and placed as the first sheet?

The original data in the sheets look like this:

Thanks for your help and time.

Here is the code:

Private Sub FindAndCreateReport()

' Declare variables we will use to loop through each worksheet
Dim eWs As Worksheet
Dim rFound As Range

' Declare variables to check if we are done looping through the worksheet
Dim rLastCell As Range
Dim rFirstCell As Range

' Declare and prepare the variable to hold the string we are looking for
Dim strLookFor As String
strLookFor = InputBox("Text to Search for")
If Len(Trim(strLookFor)) = 0 Then Exit Sub

' Declare and prepare variables used when creating the report
Dim rCellwsReport As Range
Dim wsReport As Worksheet
Set wsReport = ThisWorkbook.Sheets.Add
Set rCellwsReport = wsReport.Cells(1, 1)

On Error Resume Next                            '<~ skip all errors encountered

' Start looping through this workbook
For Each eWs In ThisWorkbook.Worksheets
If eWs.Name = wsReport.Name Then GoTo NextSheet '<~ skip if we are checking the report sheet
  With eWs.UsedRange
    ' Set the lastcell. So we can start the search from the bottom.
    Set rLastCell = .Cells(.Cells.Rows.Count)

    ' Initial search for the string.
    Set rFound = .Find(what:=strLookFor, after:=rLastCell)
  End With
  If Not rFound Is Nothing Then                 '<~ if we found something then?

    ' Set it as the first find.
    Set rFirstCell = rFound

    ' Write its details to the report through this small sub.
    WriteDetails rCellwsReport, rFound
  End If
  Do
    ' Continue looking for more matches
    Set rFound = eWs.UsedRange.Find(what:=strLookFor, after:=rFound)
    ' If there are matches, write them down the report sheet.
    WriteDetails rCellwsReport, rFound

  Loop Until rFound.Address = rFirstCell.Address '<~ loop through until the current cell is the first cell
NextSheet:
Next

End Sub

Private Sub WriteDetails(ByRef rReceiver As Range, ByRef rDonor As Range)
  rReceiver.Value = rDonor.Parent.Name
  rReceiver.Offset(, 1).Value = rDonor.Address
  Set rReceiver = rReceiver.Offset(1, 0)
End Sub