How to get cell row from current function VBA Excel - arrays

Question

Here is the VBA function that populates an array with a unique set of months, generated from a start month and an end month:
Function get_months(matrix_height As Integer) As Variant
Worksheets("Analysis").Activate
Dim date_range As String
Dim column As String
Dim uniqueMonths As Collection
Set uniqueMonths = New Collection
Dim dateRange As range
Dim months_array() As String 'array for months
column = Chr(64 + 1) 'A
date_range = column & "2:" & column & matrix_height
Set dateRange = range(date_range)
On Error Resume Next
Dim currentRange As range
For Each currentRange In dateRange.Cells
If currentRange.Value <> "" Then
Dim tempDate As Date: tempDate = CDate(currentRange.Text) 'Convert the text to a Date
Dim parsedDateString As String: parsedDateString = Format(tempDate, "MMM-yyyy")
uniqueMonths.Add Item:=parsedDateString, Key:=parsedDateString
End If
Next currentRange
On Error GoTo 0 'Enable default error trapping
'Loop through the collection and view the unique months and years
Dim uniqueMonth As Variant
Dim counter As Integer
counter = 0
For Each uniqueMonth In uniqueMonths
ReDim Preserve months_array(counter)
months_array(counter) = uniqueMonth
Debug.Print uniqueMonth
counter = counter + 1
Next uniqueMonth
get_months = months_array
End Function
How can I manipulate this function to return the cell rows of each of the values that are being added to my months array.
What would be the best way to store these two values i.e. The Date (Oct-2011) & the Row Number (i.e. 456)
Tow arrays? Then return an array with these two arrays within it?
Can anyone give provide a solution to this problem?

Answer 1

NOT FULLY TESTED
Just a quick example I threw together think this is what you are looking for, let me know of any changes you may need and I'd be glad to help.
This is sloppy and unfinished but working, as far as I know, Test in a copy of your actual data and not on your actual data. When I get some more time I can try to clean up more.
Function get_months(matrix_height As Integer) As Variant
Dim uniqueMonth As Variant
Dim counter As Integer
Dim date_range() As Variant
Dim column As String
Dim uniqueMonths As Collection
Dim rows As Collection
Set uniqueMonths = New Collection
Set rows = New Collection
Dim dateRange As Range
Dim months_array() As String 'array for months
date_range = Worksheets("Analysis").Range("A2:A" & matrix_height + 1).Value
On Error Resume Next
For i = 1 To matrix_height
If date_range(i, 1) <> "" Then
Dim parsedDateString As String: parsedDateString = Format(date_range(i, 1), "MMM-yyyy")
uniqueMonths.Add Item:=parsedDateString, Key:=parsedDateString
If Err.Number = 0 Then rows.Add Item:=i + 1
Err.Clear
End If
Next i
On Error GoTo 0 'Enable default error trapping
'Loop through the collection and view the unique months and years
ReDim months_array(uniqueMonths.Count, 2)
For y = 1 To uniqueMonths.Count
months_array(y, 1) = uniqueMonths(y)
months_array(y, 2) = rows(y)
Next y
get_months = months_array
End Function
And can be called like:
Sub CallFunction()
Dim y As Variant
y = get_months(WorksheetFunction.Count([A:A]) - 1)
End Sub

Answer 2

Function:
Function get_months() As Variant
Dim UnqMonths As Collection
Dim ws As Worksheet
Dim rngCell As Range
Dim arrOutput() As Variant
Dim varRow As Variant
Dim strRows As String
Dim strDate As String
Dim lUnqCount As Long
Dim i As Long
Set UnqMonths = New Collection
Set ws = Sheets("Analysis")
On Error Resume Next
For Each rngCell In ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp)).Cells
If IsDate(rngCell.Text) Then
strDate = Format(CDate(rngCell.Text), "mmm-yyyy")
UnqMonths.Add strDate, strDate
If UnqMonths.Count > lUnqCount Then
lUnqCount = UnqMonths.Count
strRows = strRows & " " & rngCell.Row
End If
End If
Next rngCell
On Error GoTo 0
If lUnqCount > 0 Then
ReDim arrOutput(1 To lUnqCount, 1 To 2)
For i = 1 To lUnqCount
arrOutput(i, 1) = UnqMonths(i)
arrOutput(i, 2) = Split(strRows, " ")(i)
Next i
End If
get_months = arrOutput
End Function
Call and output:
Sub tgr()
Dim my_months As Variant
my_months = get_months
With Sheets.Add(After:=Sheets(Sheets.Count))
.Range("A2").Resize(UBound(my_months, 1), UBound(my_months, 2)).Value = my_months
With .Range("A1:B1")
.Value = Array("Unique Month", "Analysis Row #")
.Font.Bold = True
.EntireColumn.AutoFit
End With
End With
End Sub