Required references (under Tools):
Visual Basic For Applications
Microsoft Excel 16.0 Object Library
OLE Automation
Microsoft Office 16.0 Object Library
Microsoft Scripting Runtime
Code:
Private Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean
'DEVELOPER: Ryan Wells (wellsr.com)
'DESCRIPTION: Function to check if a value is in an array of values
'INPUT: Pass the function a value to search for and an array of values of any data type.
'OUTPUT: True if is in array, false otherwise
Dim element As Variant
On Error GoTo IsInArrayError: 'array is empty
For Each element In arr
If element = valToBeFound Then
IsInArray = True
Exit Function
End If
Next element
Exit Function
IsInArrayError:
On Error GoTo 0
IsInArray = False
End Function
Function RangeTypes() As Scripting.Dictionary
' https://www.experts-exchange.com/articles/3391/Using-the-Dictionary-Class-in-VBA.html
' strange keys as vba is case in-sensative and doesn't seem to recognize that i'm tring to override methods
' _ character is invalid at variable start
' using dictionary to make maintaining cell types easier
Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary
With dict
.CompareMode = vbBinaryCompare ' case sensative
.Add "BLANK", "blank"
.Add "TXT", "text"
.Add "BOOLEAN", "boolean"
.Add "ERRR", "error"
.Add "DTE", "date"
.Add "TIM", "time"
.Add "NUM", "number"
End With
Set RangeTypes = dict
End Function
Function RangeType(theRange As Range)
' https://www.extendoffice.com/documents/excel/1796-excel-check-determine-data-type.html
' useing as Range.DataTypetoText doesn't work - want to check if cell realy is a date to prevent converting an invalid date - doing so raises an error
' Application.Volatile
Set theRangeType = RangeTypes()
Select Case True
Case VBA.IsEmpty(theRange): RangeType = theRangeType("BLANK")
Case Application.IsText(theRange): RangeType = theRangeType("TXT")
Case Application.IsLogical(theRange): RangeType = theRangeType("BOOLEAN")
Case Application.IsErr(theRange): RangeType = theRangeType("ERRR")
Case VBA.IsDate(theRange): RangeType = theRangeType("DTE")
Case VBA.InStr(1, theRange.Text, ":") <> 0: RangeType = theRangeType("TIM")
Case VBA.IsNumeric(theRange): RangeType = theRangeType("NUM")
End Select
End Function
Sub Macro1()
'
' Macro1 Macro
' Fills month-year for Monthly Summary
'
' Keyboard Shortcut: Ctrl+m
'
Dim monthYearsToUse() As Variant
ReDim monthYearsToUse(0 To 1)
Dim allCells As Range
Set allCells = Worksheets("Main").Range("B3:B900")
Dim aCell As Range
Set rangeTypeTypes = RangeTypes()
' MsgBox (allCells(1).Value)
' sdictonary ("key"), Not dictonary.Key
For Each aCell In allCells
Dim cellDate As Date
Dim cellDateNoDay As Date
Dim cellDataType
cellDataType = RangeType(aCell)
If cellDataType Is rangeTypeTypes("DTE") Then
cellDate = DateValue(aCell.Value)
cellDateNoDay = DateSerial(Year(cellDate), Month(cellDate), 1)
If Not IsInArray(cellDateNoDay, monthYearsToUse) Then
Dim lower As Integer, upper As Integer
lower = LBound(monthYearsToUse)
upper = UBound(monthYearsToUse)
ReDim Preserve monthYearsToUse(lower To upper + 1)
monthYearsToUse(UBound(monthYearsToUse)) = cellDateNoDay
End If
End If
Next aCell
' monthYearsToUse will later be used to write each value into "Monthly Summary"
End Sub
Worksheet sample:
Debugging info: