I'm struggling in vein to work out how to remove 5 days from today's date...
I have the following simple code that searches compares the result of a text file array search and then compares them to today's date. If the date within the text file is older than today then it deletes, if not it doesn't.
What i want though is to say if the date in the text file is 5 days or older then delete.
This is being used in the English date format.
Sub KillSuccess()
Dim enUK As New CultureInfo("en-GB")
Dim killdate As String = DateTime.Now.ToString("d", enUK)
For Me.lo = 0 To UBound(textcis)
If textcis(lo).oDte < killdate Then
File.Delete(textcis(lo).oPath & ".txt")
End If
Next
End Sub
Thanks
You can use the AddDays method; in code that would be something like this:
Dim today = DateTime.Now
Dim answer = today.AddDays(-5)
msdn.microsoft.com/en-us/library/system.datetime.adddays.aspx
Which would make your code
Sub KillSuccess()
Dim killdate = DateTime.Now.AddDays(-5)
For Me.lo = 0 To UBound(textcis)
If textcis(lo).oDte < killdate Then
File.Delete(textcis(lo).oPath & ".txt")
End If
Next
End Sub
Related
I have a word table. I wrote a macro to get values from the table. When it runs I get a runtime error 13. When I debug and watch the value of parsing string it looks like this "2019-04-03 There is only one quote in the string. I think that is the case I couldn't convert that string into a date format. Can you help me to fix this?
The code
Sub Macro2()
Dim NumRows As Integer
Dim startDate As String
Dim days As String
Dim endDate As String
If Not Selection.Information(wdWithInTable) Then
Exit Sub
End If
NumRows = Selection.Tables(1).Rows.Count
'Loop to select each row in the current table
For J = 2 To NumRows
'Loop to select each cell in the current row
startDate = Selection.Tables(1).Rows(J).Cells(5).Range.Text
days = Selection.Tables(1).Rows(J).Cells(6).Range.Text
FormatDate = CDate(ends)
endDate = DateAdd("d", days, FormatDate)
Selection.Tables(1).Rows(J).Cells(7).Range.Text = endDate
Next J
End Sub
The table
Here's the minimal change I found that works for me when tested in Word 2013.
General points:
I added Option Explicit so that the computer would help me find errors. In this case, the variables J and FormatDate were used but not Dimed, and ends was used but never initialized (I changed it to startDate).
The Range.Text in a table cell includes whitespace and the end-of-table marker (ยค). That is why CDate was giving an error.
For the dates, I used Left() to take only the left ten characters, since you seem to always be using yyyy-mm-dd-format dates.
For the counts of days, since those can be of any length, I used Range.Words(1).Text to keep only the first Word (as MS Word defines it), which is the number.
I also added the CLng() call in the parameter to DateAdd, since DateAdd wants a number* rather than a string.
For production use, I would also recommend using Selection only in one place, and doing Dim workTable as Table: Set workTable = Selection.Tables(1). That will simplify your code.
Code
<=== marks changed lines
Option Explicit ' <==
Sub Macro2()
Dim NumRows As Integer
Dim startDate As String
Dim days As String
Dim endDate As String
If Not Selection.Information(wdWithInTable) Then
Exit Sub
End If
NumRows = Selection.Tables(1).Rows.Count
'Loop to select each row in the current table
Dim J As Long ' <==
For J = 2 To NumRows
'Loop to select each cell in the current row
startDate = Selection.Tables(1).Rows(J).Cells(5).Range.Text
startDate = Left(startDate, 10) ' <== Remove the space and table mark
days = Selection.Tables(1).Rows(J).Cells(6).Range.Words(1).Text ' <===
Dim FormatDate As Date ' <==
FormatDate = CDate(startDate) ' <== not `ends`
endDate = DateAdd("d", CLng(days), FormatDate) ' <=== clng
Selection.Tables(1).Rows(J).Cells(7).Range.Text = endDate
Next J
End Sub
* DateAdd actually takes a Double, but VBA can promote Long to Double. I chose CLng since it looks like you are only using integer day spans. If not, use CDbl instead.
Try:
Sub Demo()
Dim r As Long
With Selection
If Not .Information(wdWithInTable) Then Exit Sub
With .Tables(1)
For r = 2 To .Rows.Count
.Cell(r, 7).Range.Text = _
Format(DateAdd("d", Split(.Cell(r, 6).Range.Text, vbCr)(0), CDate(Split(.Cell(r, 5).Range.Text, vbCr)(0))), "YYYY-MM-DD")
Next r
End With
End With
End Sub
I need some help with my excel vba.
First of all let me tell what it should do...
On a network folder there are pdf-files which should be count.
Folders look like this:
X:/Tests/Manufact/Prod_1/Machine/Num/Year/Month/TEST_DDMMYYYY_TIMESTAMP.PDF
X:/Tests/Manufact/Prod_2/Machine/Num/Year/Month/TEST_DDMMYYYY_TIMESTAMP.PDF
X:/Tests/Manufact/Prod_3/Machine/Num/Year/Month/TEST_DDMMYYYY_TIMESTAMP.PDF
Also there is a folder for each year and for each month, where the pdfs are sorted based on their date of creation.
The files counted should be listed in the active sheet as a list with filename and date.
After that I want to count how many pdf-files were created on a specific day between a given time. Should be in a new sheet like
Date - Time-Period 1 (0AM-6AM) - Time Period 2 (6AM-10AM) - Time Period 3 (10AM - 12AM)
01.01.2017 - 12PDFs - 17PDFs - 11PDFs
02.01.2017 - 19PDFs - 21PDFs - 5PDFs
Maybe there is also a way of memory, so the script does not count all the files again which were already listed before? (Cause there are more than 100k pdfs and it's increasing everyday...)
So... I searched a whole week on the internet for solutions, and I found a few, ending me up with this code:
Sub ListFiles()
Const sRoot As String = "X:\Tests\Manufact\"
Dim t As Date
Application.ScreenUpdating = False
With Columns("A:E")
.ClearContents
.Rows(1).Value = Split("File,Date,Day,Time,Size", ",")
End With
t = Timer
NoCursing sRoot
Columns.AutoFit
Application.ScreenUpdating = True
MsgBox Format(Timer - t, "0.0s")
End Sub
Sub NoCursing(ByVal sPath As String)
Const iAttr As Long = vbNormal + vbReadOnly + _
vbHidden + vbSystem + _
vbDirectory
Dim col As Collection
Dim iRow As Long
Dim jAttr As Long
Dim sFile As String
Dim sName As String
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
Set col = New Collection
col.Add sPath
iRow = 1
Do While col.count
sPath = col(1)
sFile = Dir(sPath, iAttr)
Do While Len(sFile)
sName = sPath & sFile
On Error Resume Next
jAttr = GetAttr(sName)
If Err.Number Then
Debug.Print sName
Err.Clear
Else
If jAttr And vbDirectory Then
If Right(sName, 1) <> "." Then col.Add sName & "\"
Else
iRow = iRow + 1
If (iRow And &HFFF) = 0 Then Debug.Print iRow
Rows(iRow).Range("A1:E1").Value = Array(sName, _
FileDateTime(sName), _
FileDateTime(sName), _
FileDateTime(sName), _
FileLen(sName))
End If
End If
sFile = Dir()
Loop
col.Remove 1
Loop
End Sub
What it does is counting ALL files in the directorys (So there is something missing telling it to only count PDFs).
It does list the files in my sheet, I'm happy with that part, but it only lists it. I still need the sorting part, so either only let it count day and time period, or let it count/list everything first and afterwards sort and count only the day and time period from the list (I really don't know which one would be better, maybe there is an easy way and a hard one?)
So if any one has a clue how to do that, please let me know, I'm thankful for any help!
Best Regards - Jan
OK I just worked on a similar project not to long ago. I am going to assume something here and you tell me if anything will break the whole system.
1) We can and are allowed to move .PDF files to a sub folder after we process it, or
2) We can and are allowed to rename (even temporary) .PDF files.
3) If we pass a month we do not need to process it any longer, for example today we are in February of 2017, so we stopped processing January 2017 files.
If we can and are allowed to proceed with these assumptions, then to lessen the double work, once a .PDF is processed it could be either moved to a sub folder called Processed Files within that month's folder, and at the end of the month we can return them back, or renamed by appending it with a special tag say "PrOCed" if that string will never ever appear in the file name, and then we can exclude any files in that new folder or with that tag.
I would suggest that you would simply read all the file names into a worksheet and then use Text-to-Columns to get the date and time of the file creation, plus maybe you can use the FileSystemObject to get that info to, and then simply use the Excel Group feature to get the breakdown by day and hour.
Hope this helps, if you need any code example, let me know.
Here's how I would do it. The following is largely untested
and should really be treated as pseudocode. Besides it's not
clear that I could give a definitive answer as I've had to make too
many assumptions (ie is Num in the directory just 'Num' or is
it a number, how is TIMESTAMP defined, etc).
I'm assuming that your pdfs will be properly filed in the
correct month folder.
Ie, for example, you won't have
say a month '09' in a '10' folder (this would be an error condition). If that's the case then
what I'm proposing should work. Note that I'm also assuming that
the filenames are correct. If not you can add additional error
processing. Right now if I find an error in the filename I simply skip it - but
you'll probably want to have it printed out as mentioned in the
code comments.
The main data structure is a dictionary that should end up having
a day entry (ie key,value) for each day of the month once all the pdfs for that
month have been processed. The key of this dictionary is a 2 digit
string that represents the day from '01' up to '31' (for the months that
have 31 days). The value is a 1 dimensional array of length 3. So a typical
entry could be (20,31,10) which is 20 files for period 1, 31 for period 2 and
10 for period 3.
For each file you process a regular expression that extracts the day and hour only.
I'm assuming that the period hours don't overlap (just makes things easier - ie so
I don't have to bother with minutes). Once that's extracted I then add to
that days array for the correct time period based on the hour I've found.
You should note that I assume if you've gone through all product directories
for a given month you have now all that months files. So with all the month
files you can now print out the period counts on a different worksheet for each
day.
I haven't bothered implementing 'SummarizeFilesForMonth' but this should be
relatively straightforward once everything else has been debugged. This is
the place where you'll iterate through the day keys in the proper order to
print out the period stats. Other than that there shouldn't have to be any
other additional sorting.
Option Explicit
' Gets all files with the required file extension,
' strips off both the path and the extension and
' returns all files as a collection (which might not be
' what you want - ie might want the full path on the 1st sheet)
Function GetFilesWithExt(path As String, fileExt As String) As Collection
Dim coll As New Collection
Dim file As Variant
file = dir(path)
Dim fileStem As String, ext As String
Do While (file <> "")
ext = Right(file, Len(file) - InStrRev(file, "."))
If ext = fileExt Then
fileStem = Right(file, Len(file) - InStrRev(file, "\"))
coll.Add Left(fileStem, Len(file) - 5)
End If
file = dir
Loop
Set GetFilesWithExt = coll
End Function
' Checks whether a directory exists or not
Function pathExists(path As String)
If Len(dir(path, vbDirectory)) = 0 Then
pathExists = False
Else
pathExists = True
End If
End Function
' TEST_DDMMYYYY_TIMESTAMP is the filename being processed
' assuming TIMESTAMP is hr min sec all concatenated with
' no intervening spaces and all are always 2 digits
Sub UpdateDictWithDayFile(ByRef dictForMonth As Variant, file As String)
Dim regEx As New RegExp
' only extracts day and hour - you'll almost certainly
' have to adjust this regular expression to suit your needs
Dim mat As Object
Dim Day As String
Dim Hour As Integer
regEx.Pattern = "TEST_(\d{2})\d{2}\d{4}_(\d{2})\d{2}\d{2}$"
Set mat = regEx.Execute(file)
If mat.Count = 1 Then
Day = mat(0).SubMatches(0) ' day is a string
Hour = CInt(mat(0).SubMatches(1)) ' hour is an integer
Else
' Think about reporting an error here using debug.print
' i.e., the filename isn't in the proper format
' and will not be counted
Exit Sub
End If
If Not dictForMonth.exists(Day) Then
' 1 dimensional array of 3 items; one for each time period
dictForMonth(Day) = Array(0, 0, 0)
End If
Dim periods() As Variant
periods = dictForMonth(Day)
' I'm using unoverlapping hours unlike what's given in your question
Select Case Day
Case Hour <= 6
periods(0) = periods(0) + 1
Case Hour >= 7 And Hour < 10
periods(1) = periods(1) + 1
Case Hour >= 10
periods(2) = periods(2) + 1
Case Else
' Another possible error; report on debug.print
' will not be counted
Exit Sub
End Select
End Sub
Sub SummarizeFilesForMonth(ByRef dictForMonth As Variant)
' This is where you write out the counts
' to the new sheet for the month. Iterate through each
' day of the month in 'dictForMonth' and print
' out each of pdf counts for the individual periods
' stored in the 1 dimensional array of length 3
End Sub
Sub ProcessAllFiles()
' For each day of the month for which there are pdfs
' this dictionary will hold a 1 dimensional array of size 3
' for each
Dim dictForMonth As Object
Dim year As Integer, startYear As Integer, endYear As Integer
Dim month As Integer, startMonth As Integer, endMonth As Integer
Dim prodNum As Integer, startProdNum As Integer, endProdNum As Integer
Dim file As Variant
Dim files As Collection
startYear = 2014
startMonth = 1
endYear = 2017
endMonth = 2
startProdNum = 1
endProdNum = 3
Dim pathstem As String, path As String
pathstem = "D:\Tests\Manufact\Prod_"
Dim ws As Worksheet
Dim row As Integer
Set ws = ThisWorkbook.Sheets("Sheet1")
row = 1
For year = startYear To endYear:
For month = 1 To 12:
Set dictForMonth = CreateObject("Scripting.Dictionary")
For prodNum = startProdNum To endProdNum
If prodNum = endProdNum And year = endYear And month > endMonth Then Exit Sub
path = pathstem & prodNum & "\Machine\Num\" & year & "\" & Format(month, "00") & "\"
If pathExists(path) Then
Set files = GetFilesWithExt(path, "pdf")
For Each file In files:
' Print out file to column 'A' of 'Sheet1'
ws.Cells(row, 1).Value = file
row = row + 1
UpdateDictWithDayFile dictForMonth, CStr(file)
Next
End If
Next prodNum
SummarizeFilesForMonth dictForMonth
Next month
Next year
End Sub
OK Thanks for confirming the limitations Jan
So then the next option is to build a list of file names in a worksheet that have been processed and pass them, for example if you are using a For Each loop to loop through the files, there will be a test to see if the current name of the file is in the list of processed files, skip it otherwise process it and add its name to the list.
3 refers to all the files in a past month. This way we can search for files by date and get new files to process. So all files generated past a certain date (last run date) will be considered new and need to be processed.
Will that work?
I am trying to make a small helper app to assist in reading SCCM logs. Parsing the dates has been pretty straightforward until I get to the timezone offset. It is usually in the form of "+???". literal example: "11-01-2016 11:44:25.630+480"
DateTime.parse() handles this well most of the time. But occasionally I run into a time stamp that throws an exception. I cannot figure out why. This is where I need help. See example code below:
Dim dateA As DateTime = Nothing
Dim dateB As DateTime = Nothing
Dim dateStr_A As String = "11-07-2016 16:43:51.541+600"
Dim dateStr_B As String = "11-01-2016 11:44:25.630+480"
dateA = DateTime.Parse(dateStr_A)
dateB = DateTime.Parse(dateStr_B)
MsgBox(dateA.ToString & vbCrLf & dateB.ToString)
IF run it would seem dateStr_B is an invalid time stamp? Why is this? I've tried to figure out how to handle the +480 using the 'zzz' using .ParseExact() format as shown here Date Formatting MSDN
Am I missing something with the timezone offset? I've searched high and low but these SCCM logs seem to use a non standard way of representing the offset. Any insight would be greatly appreciated
The problem is that +480 is indeed an invalid offset. The format of the offset from UTC (as produced when using the "zzz" Custom Format Specifier) is hours and minutes. +600 is 6 hours and 0 minutes ahead of UTC, which is valid. +480 would be 4 hours and 80 minutes ahead of UTC, which is invalid as the number of minutes can't be more than 59.
If you have some external source of date and time strings that uses an offset that is simply a number of minutes (i.e. +600 means 10 hours and +480 means 8 hours), you will need to adjust the offset before using DateTime.Parse or DateTime.ParseExact.
[Edit]
The following function takes a timestamp with a positive or negative offset (of any number of digits) in minutes, and returns a DateTime. It throws an ArgumentException if the timestamp is not in a valid format.
Public Function DateTimeFromSCCM(ByVal ts As String) As DateTime
Dim pos As Integer = ts.LastIndexOfAny({"+"c, "-"c})
If pos < 0 Then Throw New ArgumentException("Timestamp must contain a timezone offset", "ts")
Dim offset As Integer
If Not Integer.TryParse(ts.Substring(pos + 1), offset) Then
Throw New ArgumentException("Timezone offset is not numeric", "ts")
End If
Dim hours As Integer = offset \ 60
Dim minutes As Integer = offset Mod 60
Dim timestamp As String = ts.Substring(0, pos + 1) & hours.ToString & minutes.ToString("00")
Dim result As DateTime
If Not DateTime.TryParse(timestamp, result) Then
Throw New ArgumentException("Invalid timestamp", "ts")
End If
Return result
End Function
Thank you for the insight. I had a feeling I would need to handle this manually. I just wanted to make sure I wasn't missing something simple in the process. My knowledge of the date and time formatting is a bit lacking.
As such, I have altered my code so that it handles the offset. Granted I will have to add some more input validation in the final product.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim dateA As DateTime = Nothing
Dim dateB As DateTime = Nothing
Dim dateStr_A As String = correctOffset("11-07-2016 16:43:51.541+600")
Dim dateStr_B As String = correctOffset("11-07-2016 16:43:51.541+480")
dateA = DateTime.Parse(dateStr_A)
dateB = DateTime.Parse(dateStr_B)
MsgBox(dateA.ToString & vbCrLf & dateB.ToString)
End Sub
Public Function correctOffset(ByVal ts As String)
Dim offset As Integer = CInt(ts.Substring(ts.Length - 3))
Dim offHour As Integer = offset / 60
Dim offMin As Integer = offset - (offHour * 60)
Dim strhour As String = Nothing
Dim strmin As String = Nothing
If offHour <= 9 Then
strhour = "0" & CStr(offHour)
Else
strhour = CStr(offHour)
End If
If offMin <= 9 Then
strmin = "0" & CStr(offMin)
Else
strmin = CStr(offMin)
End If
Return ts.Substring(0, ts.Length - 3) & strhour & ":" & strmin
End Function
My code is as follows:
Private Sub tbRcvrDepartTime_textchanged(sender As Object, e As EventArgs) Handles tbRcvrDepartTime.TextChanged
'Converts the 90 Receiver Arrival & Departures Date & Times to a string for comparison
Dim raTime As String = tbRcvrArriveTime.Text 'Takes the Time only String and converts to string
Dim raDate As String = dpRcvrArriveDate.Text 'Takes the DateTimePicker and converts date to string
Dim raDateString = String.Concat(raDate, " ", raTime) 'Puts together the Date & Time into one continuous string
'Dim raDateFormat As String = "MM-dd-yyyy HH:mm" 'Sets the String to Date style Format
Dim raResultDate As Date = CDate(raDateString) 'Finalizes the String for use in below comparison
Dim rdTime As String = tbRcvrDepartTime.Text 'Takes the Time only String and converts to string
Dim rdDate As String = dpRcvrDepartDate.Text 'Takes the DateTimePicker and converts date to string
Dim rdDateString = String.Concat(rdDate, " ", rdTime) 'Puts together the Date & Time into one continuous string
'Dim rdDateFormat As String = "MM-dd-yyyy HH:mm" 'Sets the String to Date Format
Dim rdResultDate As Date = CDate(rdDateString) 'Finalizes the String for use in below comparison
'Checks to see if 2 or more hours have elapsed since Receiver Arrival/Departure Date & Time
Dim elapsedR As TimeSpan = rdResultDate.Subtract(raResultDate)
tbRcvrDepartTime.BackColor = If(elapsedR.TotalMinutes > 120, Color.LightPink, Color.White)
End Sub
Both raTime & rdTime are separate textboxes.
Both raDate & rdDate are datetimepickers.
When I run the code "live" initially the first record I look at is displayed correctly. Once I move to another record, this goes out the window... I get random results where it will not change the backcolor to the proper color if >120 minutes has elapsed. Other times it changes the backcolor when there is <120 minutes elapsed. Sometimes no change in backcolor when it should or it will change color when it should not. I attempted to originally do this using TotalHours but met with the same results. It is random and is not consistent. I have worked on this for 2 days now with no difference in results. My thinking is there needs to be a way to "refresh" the rdResultDate & raResultDate info when each new record is loaded but I am unable to do that with my code knowledge.
The code must be able to take into account if a new date is present - ie raDate: 11/01/2016 and raTime: 23:46 and
rdDate: 11/02/2016 and rdTime: 03:00 - this would exceed 2 hours (or 120 minutes) and should read "True" and change the backcolor as it is over 2 hours (or 120 minutes).
However if the following were true:
raDate: 11/01/2016 and raTime: 23:46 and
rdDate: 11/02/2016 and rdTime: 01:00 this would not exceed 2 hours (or 120 minutes) and should read "False" and would not change the backcolor.
All of this code:
Dim Detention90 As String
Try
If elapsedR.TotalMinutes > 120 Then
Detention90 = "True"
Else
Detention90 = "False"
End If
Select Case Detention90.ToString
Case = "True" : tbRcvrDepartTime.BackColor = Color.LightPink
Case Else : tbRcvrDepartTime.BackColor = Color.White
End Select
Catch ex As Exception
'If a problem occurs, show Error message box
MessageBox.Show("Receiver Arrive Time & Depart Time Elapsed error" & vbCrLf & "Lines 1424-1434")
End Try
condenses down to just this:
Dim elapsedR As TimeSpan = rdResultDate.Subtract(raResultDate)
tbRcvrDepartTime.BackColor = If(elapsedR.TotalMinutes > 120, Color.LightPink, Color.White)
Not sure if it will directly address your issue, but it was a bit too much for a comment and I've found compacting code in this way is often extremely beneficial for tracking down difficult bugs.
But in this case, I suspect the main issue is parsing the datetime values... that you're not always parsing the DateTime value you expect from a given input string. Specifically, you have format string variables raDateFormat and rdDateFormat, but then call Date.Parse() such that these format variables are never used, and you are left at the mercy of whatever the default date format is for your thread, process, or system. If you're on a system that uses a d/m/y order as in the UK instead of the US-style m/d/y, you'll end up with some strange results. You probably want DateTime.ParseExact() instead.
In Excel using VBA, I need to set a variable to equal a list of all the dates between a start and end date (similar to equaling a range containing multiple values). The catch is only the start and end date are in a range, non of the values in between.
In SQL Server I've used the Sys.Columns table to generate a list of dates between two dates that are not actually stored on that table. Is there a way to do something similar here without having each date between the start and end date written somewhere? I googled for a couple hours and didn't find anything on how to do this.
What I'm attempting to do is have a variable I can do a For Each loop on. So for each date I will check if it exists in another worksheet, if it does nothing will happen, if it does not it will be added.
I've tried:
Dim DatesInSettings As Date
DatesInSettings = StartDate To EndDate
For Each Date In DatesInSettings
'Insert commands here
Next DatesInSetting
But that clearly isn't the answer. Help?
This searches Sheet2 for dates between the start date and end dates on Sheet1 - in cells A1 and B1:
Sub RunDates()
Dim StartDate As Date
Dim EndDate As Date
Dim i As Date
StartDate = Sheet1.Range("A1")
EndDate = Sheet1.Range("B1")
For i = StartDate To EndDate
If WorksheetFunction.CountIf(Sheet2.Range("A1:A5"), i) > 0 Then
Debug.Print i; "- date found"
Else
Debug.Print i; "- date not found"
End If
Next i
End Sub
The following subroutine calls a dictionary that will store all the dates between two given endpoints. Then it uses a simple existence comparison to check if the dates on your list is inside the dictionary's items. If it's not, it's going to print them out as not in the list.
Modify accordingly to suit your needs. ;)
CODE:
Sub GetListOfDates()
Dim StartDate As Date, EndDate As Date
Dim DictOfDates As Object, DateToCheck As Variant, ListOfDates As Variant
Dim Iter As Long
Set DictOfDates = CreateObject("Scripting.Dictionary")
StartDate = "12/31/2013"
EndDate = "01/15/2014"
For Iter = StartDate + 1 To EndDate - 1
With DictOfDates
If Not .Exists(Iter) Then
.Add Iter, Empty
End If
End With
Next Iter
'--Print them somewhere.
'Range("A1").Resize(DictOfDates.Count, 1).Value = Application.Transpose(DictOfDates.Keys)
ListOfDates = Range("B1:B15").Value
For Each DateToCheck In ListOfDates
If Not DictOfDates.Exists(DateToCheck) Then
Debug.Print Str(DateToCheck) + " is not in the list!" '--Or whatever action you want.
End If
Next DateToCheck
Set DictOfDates = Nothing
End Sub
Let us know if this helps. :)
I solved it with a vector.
I hope it helps
Sub Dates_Vector()
Public Dates() As Date
ReDim Dates(End_Dat - Start_Date)
For x = 0 To End_Dat - Start_Date
Dates(x) = Dat_Ini + x
Next x
For Each Date In Dates
'Insert commands here
Next Date
End Sub