Create Array of Dates? VBA code

[NatetheGreat]

Hi there,

I have a date column, and I would like to put all dates within the column into an array. I would then like my code to say If date I am dealing with exists within the array then do nothing, and if it does not exists within the array then do some code, and also add it to the array.

How is it possible to do this ?

 

[VBA Geek]

Sub dhDate()
Dim aDates As Variant
Const dtToLookFor As Date = #7/10/2014# 'July 10th 2014
aDates = Application.Transpose(Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value)
If UBound(Filter(aDates, dtToLookFor)) > -1 Then
    ' is within the array
Else
    ' do something
    ReDim Preserve aDates(1 To UBound(aDates) + 1)
    aDates(UBound(aDates)) = dtToLookFor
End If
End Sub

 

[NatetheGreat]

Sub dhDate()
Dim aDates As Variant
Const dtToLookFor As Date = #7/10/2014# 'July 10th 2014
aDates = Application.Transpose(Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value)
If UBound(Filter(aDates, dtToLookFor)) > -1 Then
    ' is within the array
Else
    ' do something
    ReDim Preserve aDates(1 To UBound(aDates) + 1)
    aDates(UBound(aDates)) = dtToLookFor
End If
End Sub

HI Vba Geek,

This is really great code for me, I am just starting to learn array's in Vba so thanks for your help. I was wondering, if I wanted to do something whereby I create the array via application.getopenfilename multi-select, and I want to know how to add more files into an already exisiting array of files? Here is my attempt.... but code is failing at the If Filter line??

Sub buildingarryz()
Dim array1 As Variant
Dim array2 As Variant
 
Dim importbook As Workbook
array1 = Application.GetOpenFilename("Excel Files (*.xls), *.xls", _
            Title:="Select Files", MultiSelect:=True)

array2 = Application.GetOpenFilename("Excel Files (*.xls), *.xls", _
            Title:="Select Files", MultiSelect:=True)
 
For i = LBound(array2) To UBound(array2)
   
    
    If Filter(array1, array1(i)) = 1 Then
    MsgBox ("Exists")
    Else: MsgBox ("Don't Exist FOO !")
    ReDim Preserve array1(1 To UBound(array1) + 1)
    array1(UBound(array1)) = importbook
    End If
    Next i
    
    
    

End Sub

 

[NatetheGreat]

Actually, I now understand that If filter was failing because I need to do it like ubound(filter(array2, array1(I)) = 1, but when I test this I see that the ubound value is returning 0, even in cases whereby the same file is in both of the two arrays, if this is the case, I would expect ubound(filter(array2, array1(I)) to return the value of 1 ? And then I cant satisfy the condition ubound(filter(array2, array1(I)) = 1, and tell VBA to

ReDim Preserve array1(1 To UBound(array1) + 1)
    array1(UBound(array1)) = importbook

 

[VBA Geek]

The Filter function accepts only one dimensional arrays (your Multiselect = True in Application.GetOpenFileName satisfies this condition) and if matches are found returns a zero-based array. So if the UBOUND equals zero it means it found one match, if it equals 1 then it found 2 matches and so on).
Be careful that the filter function also matches sub strings within whole words, if you have an array with "Cat", "Matty", "Catty" and you search for "Cat" you will get two matches.