My team uses outlook to track completed work. All work needs to be completed within 48 hours of receipt and we need to keep strict track of it. I've managed to put together a function that counts the emails that have fallen outside of the 2 day range, but the track needs to be kept down to an hour.
No matter how many configurations I try I was unable to get my code to count within hourly range. This is what my current code looks like:
Dim OOSLAitms As Outlook.Items
Dim DateDiff As Long
Dim Filter As String
Dim i As Long
DateDiff = Now - 2
Filter = "[Received] < '" & Day(DateDiff) & _
"/" & Month(DateDiff) & _
"/" & Year(DateDiff) & "'"
Set OOSLAitms = itms.Restrict("[FlagStatus] = 0")
Set OOSLAitms = OOSLAitms.Restrict(Filter)
For i = OOSLAitms.Count To 1 Step -1
Worksheets("Sheet1").Range("F4").Value = OOSLAitms.Count
Next
This manages to count all the emails received within the calendar day, but does not take hours of the day into account. So for example if we received 300 cases on Sunday, it will count all of them up to midnight, instead of only counting ones up to current time (4pm for example).
I need help incorporating hour/minutes criteria into my code on top of day/month/year if it's possible.
There is no Received property, you must use the ReceivedTime instead.
And if you need to get hourly range only, you must specify boundaries for the search criteria:
Dim searchCriteria As String = "[ReceivedTime]<=""" + dateTimeEnd + """ AND [ReceivedTime]>=""" + dateTimeStart + """"
Okay after playing around with it some more (and a generous amount of debug messageboxes) I've managed to get it to work using the following trick:
Created an output cell 'A11' on the first sheet running a =NOW() function formatted to "ddd dd/mm/yyyy hh:mm"
Created a cell 'A1' on the processing sheet that was running 'Sheet1!A11 - 2' formula. The reason why is that for some reason when doing 'Now - 2' through VBA, even with formatting it was always giving midnight. Doing it through autocalc in cells gives correct deduction down to a second.
The reason for formatting "dd dd/mm/yyyy hh:mm" is that this is the format that the "Received" column in outlook stores the receive times. Not providing that 'ddd' in front of the datetime string results in an automation error.
Final code looks like this:
Dim OOSLAitms As Outlook.Items
Dim DateDiff As Long
Dim Filter As String
Dim Today As String
Today = Format(ThisWorkbook.Sheets("Sheet2").Range("A1"), "ddd dd/mm/yyyy hh:mm")
Filter = "[Received]" & "<" & Today
Set OOSLAitms = itms.Restrict("[FlagStatus] = 0")
Set OOSLAitms = OOSLAitms.Restrict(Filter)
Worksheets("Sheet1").Range("F4").Value = OOSLAitms.Count
Related
I have to a point in my VBA venture where i cannot avoid using loops. This time I have to do it with an offset method as well. I have looked at other postings, but the code was very long and looked complicated enough that I couldn't figure out how to simplify them for my needs. I hope someone can assist me.
I have a table in excel and all of my columns in my table have a name (makes VBA easier in my opinion). I am trying to perform a worksheet_activiate trigger that will loop through each row in column C (named "recordstatus"). And if the cell value equals "in process", then look 5 columns over at Column I (named "DeliveryDueDate"). If delivery due date is less than newdate (newdate I have already defined in my code) then record status equals "Open", else keep it as "In Process".
Below is the code I have so far. I have tested the looping and the lopping works, but will set all records to "open" even if the delivery due date is greater than what I define in the code. I have also tested to make sure the code comes back with the correct date range and it does. The code just doesn't seem to recognize my offset to look at the date and determine if the record status should change or stay the same. Any help would be greatly appreciated. I am at the tail end of this project!!! :-)
Dim c As Range
For Each c In Range("recordstatus")
If c.Value = "In Process" Then
Dim today As Date
Dim newdate As Date
today = Now()
newdate = today + 60
If c.Offset(, 5) < newdate Then
MsgBox ("works")
c.Value = "Open"
Else
c.Value = "In Process"
End If
End If
Next
Utilize Named Range
One of the reasons of using named ranges is to avoid using the wrong ranges (columns).
The Code
Option Explicit
Sub updateProgress()
Dim src As Range
Set src = Range("DeliveryDueDate")
Dim tgt As Range
Set tgt = Range("recordstatus")
Dim today As Date
today = Now()
Dim newdate As Date
newdate = today + 60
Dim i As Long
For i = 1 To tgt.Cells.Count
If tgt.Cells(i).Value = "In Process" Then
If src.Cells(i) < newdate Then
MsgBox "works"
tgt.Cells(i).Value = "Open"
Else
tgt.Cells(i).Value = "In Process"
End If
End If
Next
End Sub
I am processing a .txt file in VBA.
Amongst other tasks, I need to read in a string representing a date and display the actual date in Excel.
A date string in the .txt file looks like "190223"
This represents 23/02/2019
My challenge is to get this done.
What I have done so far is:
' ... loop
With ActiveWorkbook.Worksheets(1)
' Other statements here
' Event date time
.Range("N" & i).Value = StrReverse(Mid(.Range(keyword.Offset(0, 4).Address), 1, 2) & _
"/" & Mid(.Range(keyword.Offset(0, 4).Address), 3, 2) & _
"/" & Mid(.Range(keyword.Offset(0, 4).Address), 5, 2))
End With
But I get the undesired output:
32/20/91 ' For a date string 190223 the desired output should be 23/02/19
Any help would be much appreciated.
Thanks in advance.
Convert it into a real date
You must extract year, month and day of that string and then convert this into a real date.
Then you can format the date to what ever date format you like. The value that is saved in the cell is then a real date value (not a string!) so you can calculate with it.
I highly recommend to read How Dates Work in Excel – The Calendar System Explained + Video to understand the background and why real dates are so important.
Here is an example:
Option Explicit
Public Sub ConvertDateExample()
Const InputStr As String = "190223"
Dim InputYear As Integer
Dim InputMonth As Integer
Dim InputDay As Integer
'extract year, month and day
InputYear = Left(InputStr, 2)
InputMonth = Mid(InputStr, 3, 2)
InputDay = Right(InputStr, 2)
'put it together to a real date
Dim RealDate As Date
RealDate = DateSerial(InputYear, InputMonth, InputDay)
'write the date into a cell
Range("A1").Value = RealDate
'format that cell to your desired format
Range("A1").NumberFormat = "dd/mm/yyyy"
End Sub
Windows 10 Pro, Regional Settings to UK English.
In Excel VBA I have a string "02/05/2017 16:30"
That, in the UK, means "02 May 2017 16:30"
But VBA turns this to US format somehow and in the cell puts "05/02/2017 16:30"
The VBA code is like this
Dim sField As String
sField = "02/05/2017 16:30"
ws.Cells(1,1) = sField
I can use CDate to get around this but CDate but that requires extra code to determine which cells are dates and which aren't, whereas the implicit conversion works for all types.
Use a Date variable instead, and always provide your date in MDY in VBA.
Dim sField As Date
sField = #05/02/2017 16:30#
ws.Cells(1,1) = sField
AFAIK in VBA you must always work the 'American way', with dates MDY. It does NOT follow regional settings. Which is good, because that enables running the same code on heterogeneous environments.
This is some workaround in the VBA code:
Sub Main()
Dim myInput As String
Dim splitMe As Variant
Dim outputDate As Date
myInput = "02/05/2017 16:30"
splitMe = Split(myInput, "/")
outputDate = DateSerial(Left(splitMe(2), 4), splitMe(1), splitMe(0))
Debug.Print Format(outputDate, "DD-MMM-YY")
Debug.Print Format(outputDate, "DD-MM-YYYY")
End Sub
It takes the date as a string and it splits it by /. Then it takes the year, the month and the day and it builds a new date with the help of DateSerial(). DateSerial MSDN.
In cases like this, make sure that you are passing the correct date to excel and there you may change the format through something as easy as this:
Range("A1").NumberFormat = "m/d/yyyy"
To make sure, that you are passing the correct date, simply try Month(YourDate) over the date or Day(YourDate).
I rather use the built-in VBA functions DateSerial(year, month, day) and TimeSerial(hour, min, sec).
Dim myDateTime as date
mydateTime = DateSerial(2017, 5, 2) + TimeSerial(16, 30, 0)
ws.Cells(1,1) = myDateTime
You can then set the number formatting on the Excel cell to your liking.
I assume this is faster because there is not need to translate any string beforehand. More importantly for me as a programmer, the parameters are explicit. I don't have to worry about different regional setting.
I solved a related problem. My workbook is for use only in the UK. It has a sheet for entering details of cash collected at various venues. The user has two single-cell fields to identify each venue; typically a location and a date, but sometimes the "date" field will contain an extended location name instead.
Dates should be entered as dd/mm/yy, but almost anything recognisable is accepted except mm/dd/yy.
The details are stored in memory, then later copied to formatted worksheets for printing. I verified the storage in memory. But after the workbook had been in use for a few months, I found that if the user entered a valid date in a cell in the format dd/mm/[yy]yy (e.g. 05/11/17), and its interpretation as mm/dd/[yy]yy would also give a valid date, then the date would obscurely be printed as 11-Mar instead of 05-Nov.
Some code snippets:
'Data structure:
Public Type BkItem 'An item of income, for banking.
ItemName As String 'The first field, just a text name.
ItemDate As Date 'The second field, interpreted as a date.
ItemDateNumber As Long 'The date as internally stored as an integer.
ItemDateString As String 'Re-formatted string, e.g. "05-Nov-17".
' ...
End Type 'BkItem.
'Input validation:
BankData = Range(.Cells(BankFirstRow, BankFirstCol), _
.Cells(BankLastItemLastRow, BankLastCol))
With BankItem(BankTotalItems)
.ItemName = IName
.ItemDateString = BankData(<row>, <col>)
.ItemDateNumber = DateToLong(.ItemDateString)
End With
'Utility routine. "Paper" is a 2-dimensional array of all the data to be printed
'on one or more pages; "Dest" is a global range.:
Sub OutputDataToSheet(ByVal Size As Long, ByRef CurrentSheet As String, _
ByRef Paper() As Variant)
Worksheets(CurrentSheet).Activate
Set Dest = Worksheets(CurrentSheet).Range((Cells(1, 1)), _
(Cells(Size, LastCol)))
Dest.Value = Paper 'Copy data to final sheet for printing.
End Sub 'OutputDataToSheet.
'As we build the array "Paper", it helps to format those cells on the final
'printout worksheet which are going to contain dates.
.Range(Cells(CurRow, L15c01), Cells(CurRow, L15c01)).NumberFormat = "dd-Mmm-yyyy"
'For the item date.
.Range(Cells(CurRow, L15c01), Cells(CurRow, L15c01)).HorizontalAlignment = xlCenter
If IsDate(BankItem(item).ItemDateString) Then
Paper(<row>, <col>) = BankItem(item).ItemDateNumber
'Date as a number, so OutputDataToSheet preserves UK date format.
Else
Paper(<row>, <col>) = BankItem(item).ItemDateString
'Extension of name.
End If 'IsDate(.ItemDateString).
Sorry if this isn't explained overly well, im a macro newbie so im not sure if this one is even possible..
I'm looking to create a weekday table for some simple statistic reporting that automatically creates a new row each day, and removes the oldest, showing the data for the current day and 6 days previous. Ideally i'd like the current day at the top of the table, and each day the entered data in the corresponding row moves down 1 row creating space for the new day's stats.
As some background info on what im trying to do.. im basically creating a friendly UI display (offline HTML) of the data recorded in a very simple 5 column (stats) by 7 row (weekdays) table. This database will need to be updated by multiple people with limited technical ability, so im basically trying to make it as easy as possible for them to enter stats each day without having to worry about also updating to correct dates and making sure they are replacing the right days data etc. In theory, it would be great to automate the process of updating the table each day to create space for them to enter the current days data, pushing yesterdays data down one row (and if the cell ranges for the whole table always the same, it should allow me to automate the updates to the offline HTML display as well).
Any ideas?
This should get you started:
Sub WeekdayTable()
Dim tbl As Range
Dim r As Integer
Set tbl = Range("A1:E7") 'Define your table, 5 columns x 7 rows. Modify as needed.
For r = tbl.Rows.Count To 2 Step -1
tbl.Rows(r).Value = tbl.Rows(r - 1).Value
Next
'empty out row 1
tbl.Rows(1).Clear
'Assuming the column 1 contains valid DATE values, _
' we can use the DateAdd function to print the next date:
tbl.Cells(1, 1) = DateAdd("d", 1, tbl.Cells(2, 1))
End Sub
First give a name to the date header cell. (Click the cell. Look at the top left of the screen where the cell coordinates appear. "A1", "B2", etc...
In that textbox, type the header name: "MyDateHeader"
then, use this macro (you can add it to the workbook open event, or activate)
Sub YourMacro()
Dim DateHeader As Range
Set DateHeader = Range("MyDateHeader")
Dim FirstDateCell As Range
Set FirstDateCell = DateHeader.Offset(1, 0)
Dim MyDay As Integer, MyMonth As Integer, MyYear As Integer
Dim CurrDay As Integer, CurrMonth As Integer, CurrYear As Integer
MyDay = Day(FirstDateCell.Value)
MyMonth = Month(FirstDateCell.Value)
MyYear = Year(FirstDateCell.Value)
CurrDay = Day(Date)
CurrMonth = Month(Date)
CurrYear = Year(Date)
If (MyDay <> CurrDay) Or (MyMonth <> CurrMonth) Or (MyYear <> CurrYear) Then
FirstDateCell.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
DateHeader.Offset(1, 0).Value = Date 'Careful, FirstDateCell has moved down.
DateHeader.Offset(8, 0).EntireRow.Clear
End If
End Sub
Very new to working with Visual Basic / Excel. I am trying to write a quick script that enters the current time in one column, and allows the user to enter how many days/hours/minutes will pass until a new time, and output that in another column.
I'm sure this isn't the best way to do it, but what I have so far is the following. I have given up on fiddling with dates, and am just working with the time:
Sub TimeModule()
Dim DaysLeft, HoursLeft, MinutesLeft As Double
DaysLeft = Val(InputBox("Days left"))
HoursLeft = Val(InputBox("Hours left"))
MinutesLeft = Val(InputBox("Minutes left"))
Dim CurrentTime As Date
CurrentTime = TimeValue(Now())
ActiveCell.Value = CurrentTime
ActiveCell.Offset(0, 1) = CurrentTime + Time(HoursLeft, MinutesLeft, 0)
End Sub
I am getting an error, of course. If anyone could shed some light on a better way to do this, along with the functions I'm misusing, I would really appreciate it!
Edit: I would, of course ultimately like for the script to handle days as well.
I think this is possible just using cell functions in Excel, if I've understood you correctly.
For example, this is what you'd see...
Time Now: Days: Hours: Minutes: New Time:
30/05/2012 23:34 15 6 23 15/06/2012 05:57
...and this is what is in each cell (assuming top-left cell is A1)...
Time Now: Days: Hours: Minutes: New Time:
=NOW() 15 6 23 =A2+B2+TIME(C2,D2,0)
Describing each function:
NOW() returns the current date and time formatted as a date and time.
DATE(year,month,day) returns the number that represents the date in MS Excel date-time code.
TIME(hours,minutes,seconds) converts hours, minutes, and seconds given as numbers to an Excel serial number, formatted with a time format.
Dissecting the equation in the last cell:
A2 is the cell containing the current date/time (as of last worksheet calculation).
B2 is the user-inputted value for days.
TIME(C2,D2,0) is the TIME() function, taking the user-inputted values for hours and minutes from cells C2 and D2 respectively.
Is this anything like your intended functionality...?
If you want to use VBA the only issue with your code is the "Time" function.
You can use CDate instead :
Sub TimeModule()
Dim DaysLeft, HoursLeft, MinutesLeft As Double
DaysLeft = Val(InputBox("Days left"))
HoursLeft = Val(InputBox("Hours left"))
MinutesLeft = Val(InputBox("Minutes left"))
Dim CurrentTime As Date
CurrentTime = TimeValue(Now())
ActiveCell.Value = Now()
ActiveCell.Offset(0, 1) = ActiveCell.Value + DaysLeft + CDate(HoursLeft & ":" & MinutesLeft)
'ActiveCell.Offset(0, 1) = CurrentTime + Time(HoursLeft, MinutesLeft, 0)
End Sub
When you 'Dim' in that fashion, you have to record the data type for each variable. The way you have it MinutesLeft is a Double and everything is (by default) a Variant.
The Time function you're looking for is TimeSerial.
Dates are stored as the number of days since a certain date. To add days to a date, you can simply add the numbers together.
Sub TimeModule()
Dim lDaysLeft As Long
Dim lHoursLeft As Long
Dim lMinutesLeft As Double
Dim dtCurrent As Date
lDaysLeft = Val(InputBox("Days left"))
lHoursLeft = Val(InputBox("Hours left"))
lMinutesLeft = Val(InputBox("Minutes left"))
dtCurrent = Now()
ActiveCell.Value = dtCurrent
ActiveCell.Offset(0, 1).Value = dtCurrent + lDaysLeft + TimeSerial(lHoursLeft, lMinutesLeft, 0)
End Sub