Look within a date range and return values that are duplicated

[Jowej]

Hi, is there a way to look between a specified date range and return the names that have 3 or more records.

For instance in column A is the dates and column B is names

21/03/18 Bob Smith
21/03/18 Jane Doe
22/03/18 Lois Lane
22/03/18 Clark Kent
23/03/18 Bob Smith
23/03/18 Spider Man
23/03/18 Bat Man
24/03/18 Bob Smith

So if I were to look between these dates then it the result would be Bob Smith. Ideally I would like this to display in a separate table, this could be either within the same sheet of another, whichever one a formula would work best

 

[ranman256]

use this code, paste into the form.
make a form w 2 textboxes: txtStartDate, txtEndDate.
you enter start,end dates on the form and when it runs,
it scans the dates, then posts a flag on the records that fit in the range.
then you can run a pivot table on the results and find what records have counts>3

be sure to set your column settings in:
Const kFLAGfldLtr = "D" 'column for the flag field
Const kDATEfld = "A" 'date field to check

make a button to run btnFind_Click()

Private Sub btnFind_Click()
Dim vStart As Date, vEnd As Date, vDat As Date
Dim iFlagCol As Long, r As Long, iDatCol As Long
Const kFLAGfldLtr = "D"     'column for the flag field
Const kDATEfld = "A"


If Not IsValidForm() Then Exit Sub


iFlagCol = Range(kFLAGfldLtr & "1").Column
iDatCol = Range(kDATEfld & "1").Column


Range("A2").Select
r = ActiveSheet.UsedRange.Rows.Count


  'clear the field flags
Columns(kFLAGfldLtr & ":" & kFLAGfldLtr).Clear
Range(kFLAGfldLtr & "1").Value = "Found"
vStart = txtStartDate
vEnd = txtEndDate
    
    'flag matching records
Range("A2").Select
While ActiveCell.Value <> ""
   vDat = ActiveCell.Offset(0, iDatCol - 1).Value
   If vStart <= vDat And vDat <= vEnd Then
       ActiveCell.Offset(0, iFlagCol - 1).Value = True
   End If
   
   ActiveCell.Offset(1, 0).Select  'next row
Wend


Range(kFLAGfldLtr & "1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$" & kFLAGfldLtr & "$" & r).AutoFilter Field:=iFlagCol, Criteria1:="<>"


Unload Me
End Sub