unique months in date range

[Godders199]

Hello, I currently have the following code to calculate howmany entries there are for each employee with in the date range (daterng2 &daterng3).
I have now been asked to add an additional column which willbe cells(I,7) detailing how many unique months those entries fall under. Ie
01/01/2018
01/01/2018
01/03/2018
01/05/2018
01/05/2018
Should return the value 3.
Am I able to add to this code to calculate the number ofmonths? Or do I need to start again from scratch. Looking on google I can’t find any example ofVBA for this.

Dim lastrowcolumnA As Long
lastrowcolumnA = Range("a" &Rows.Count).End(xlUp).row
For i = 2 To lastrowcolumnA
Cells(i, 6) =WorksheetFunction.CountIfs(ThisWorkbook.Sheets("Adviserdata").Range("A:A"), Cells(i, 1), ThisWorkbook.Sheets("Adviserdata").Range("d:d"), ">=" & Daterng2,ThisWorkbook.Sheets("Adviser data").Range("d:d"),"<=" & Daterng3)

Thanks

 

[CalcSux78]

You could use a Dictionary Object to count unique items.

Function CountUnique(ByVal rng As Range) As Long
Dim dCount As Object
Dim cel As Range


Set dCount = CreateObject("Scripting.Dictionary")
For Each cel In rng.Cells
    dCount(cel.Value) = dCount(cel.Value) + 1
Next cel


CountUnique = dCount.Count
End Function

 

[Godders199]

thanks, but i only need to count unique months relating to the staff reference in column A witin the ae range given , not sure how this will work.

 

[Godders199]

So I have been working away on this. Have added column P in the adviser data sheet,which returns the month, I now just need to add up each unique month using the same criteria as this code.
Cells(i, 26) =WorksheetFunction.CountIfs(ThisWorkbook.Sheets("Adviserdata").Range("A:A"), Cells(i, 1),ThisWorkbook.Sheets("Adviser data").Range("d:d"),">=" & Daterng2, ThisWorkbook.Sheets("Adviser data").Range("d:d"),"<=" & Daterng3)