I would like to calculate a new invoice date as follows:
Starting Date + 14 days
Where days includes weekends, but excludes holidays.
How can I do this?
The WorkDays and Networkdays functions don't quite seem to meet my needs.
The definition of 'holidays' differs by country, company, year, etc., so there's no standard function that would fit your needs. Here's an overly simplified version of my preferred method:
Function GetNetWorkDays(DateStart As Date, DateEnd As Date) As Integer
Dim i As Date
i = DateStart
While i < DateEnd
If i <> #01/01/1900# and _
i <> #01/02/1900# Then _
GetNetWorkDays = GetNetWorkDays + 1
i = i + 1
Wend
Exit Function
End Function
where #01/01/1900# and #01/02/1900# are your holidays of choice. In the long run, you'd want to move the date criteria into a table of it's own.
I understand that you want a solution with formulas, not VBA.
Suppose you have:
A4:A8 -> your holidays table
A14 -> your start date
A16 -> number of days to add
Generate the following aux structure:
c3 -> put a zero
c4 -> =IF(AND(A4-A$14>0,(A4-A$14)<=(A$16+SUM(C$3:C3))),1,0)
c5:c8 -> Copy down from c4
So, to obtain the new date, type the following in the result cell:
=A14+A16+SUM(C4:C8)
HTH!
Thanks for your responses.
In the end I went for this:
Public Function GetCalendarDaysExHolidays(DateStart As Date, MaxDate As Date, NumDays As Integer) As Date
Dim i As Date
Dim DaysCounted As Integer
Dim Rng As Range
DaysCounted = 0
i = DateStart
Do While i < MaxDate
Set Rng = Sheets("Bank holidays").Range("A1:A1000").Find(what:=Format(DateValue(i), "DD/MM/YYYY"), LookAt:=xlWhole, LookIn:=xlFormulas)
If Rng Is Nothing Then
DaysCounted = DaysCounted + 1
End If
i = i + 1
If (DaysCounted = NumDays) Then
GetCalendarDaysExHolidays = i
Exit Do
End If
Loop
Exit Function
End Function
Related
I am wondering what Excel/VBA functions I can use to find the last day of a month in a range with the specific year and month input values.
For example, with '1995' and '3', it should return '3/31/1995'.
With '1995' and '4', it should return '4/28/1995'.
Note that the actual last day of '04/1995' was '4/30/1995'. I am looking for the last day in the range, '4/28/1995', so I can't just blindly use the EOMONTH function.
Below is a VBA solution that should work and be relatively fast.
I'm adding all items in the range that match the year and month to an ArrayList. Then, I'm sorting that list in ascending order and picking the last item in the list (this item should possess the largest value in the set).
This is running in less than a second going through a list of about 800 items.
Function:
Option Explicit
Public Function MaxDateInRange(SearchRange As Range, _
YearNumber As Long, _
MonthNumber As Long) As String
Dim cell As Range
Dim ListIndex As Long
Dim List As Object: Set List = CreateObject("System.Collections.ArrayList")
'Go through all cells, and all items that match the month and year to a list
For Each cell In SearchRange
If IsDate(cell) Then
If Month(cell) = MonthNumber And Year(cell) = YearNumber Then List.Add (cell)
End If
Next
'Sort the list ascending, then select the last item in that list
List.Sort
ListIndex = List.Count - 1
'Bounds check, to see if anything was found, otherwise return ""
If ListIndex >= 0 Then
MaxDateInRange = List(ListIndex)
Else
MaxDateInRange = vbNullString
End If
End Function
Usage:
Public Sub Example()
Dim rng As Range: Set rng = Sheets(2).Range("D1:D795")
Dim t As Double
t = Timer
Debug.Print MaxDateInRange(rng, 2019, 3)
Debug.Print MaxDateInRange(rng, 2019, 4)
Debug.Print "Process took " & Timer - t
End Sub
Debug Output based on sample data:
2019-03-28
2019-04-25
Process took 0.04296875
Another method could be as follows, I've not fully tested, but could be food for thought.
Function get_latest_date(rngInput As Excel.Range, intMonth As Integer, lngYear As Long) As Date
get_latest_date = 0
On Error Resume Next
get_latest_date = Application.Evaluate( _
"=MAX(IF((YEAR(" & _
rngInput.Address & _
")=" & lngYear & _
")*(MONTH(" & _
rngInput.Address & _
")=" & intMonth & ")," & rngInput.Address & "))")
End Function
This uses the evaluation of an array formula built from arguments passed in.
I have dummy dates, 10,000 in total, from 2015 to over 2030. I ran a quick test using the below
Function test_get_last_date()
Dim r As Excel.Range
Dim lYear As Long
Dim iMonth As Integer
Dim dTimer As Double
Set r = Range("a1:a10000")
dTimer = Timer
For lYear = 2015 To 2030
For iMonth = 1 To 12
Debug.Print get_latest_date(r, iMonth, lYear), "Took : "; Timer - dTimer
dTimer = Timer
Next iMonth
Next lYear
End Function
This gave these results
31/05/2017 Took : 0.02734375
30/06/2017 Took : 0.015625
31/07/2017 Took : 0.015625
31/08/2017 Took : 0.015625
30/09/2017 Took : 0.01953125
You have 2 options :
Your data are sorted and you can use match with 1 or -1 third option. As comment from Darren Bartrup-Cook says
Else you have to add 2 columns of formula to sort your solution:
Column B, formula =year(A:A)&MONTH(A:A) ; concatenate your criteria
Column C, formula from cell C2 =IFERROR(MAX((B$1:B1=B2)*(C$1:C1)),A2) ; then expand formula down
The last value in column C for each unique month in column B will be your answers. You can extract results in Column D with formula from cell D2 =MAX(IF(B:B=B2,C2)) ; then expand formula down
I have separate the date into day, month & year column, then use MAXIFS.
=MAXIFS(B:B,C:C,3,D:D,1995)
Guys my primary objective is to avoid invalid days.
In sheet 1 i have:
A1 data validation with years (from 1900-2019)
B1 data validation with all months
C1 i use change event (if both fields A1 & A2 are not empty) calculate how many days the selected month has based on the selected year and create a data validation includes all available days.
For days calculation i use:
Option Explicit
Sub test()
Dim ndays As Long
With ThisWorkbook.Worksheets("Sheet1")
ndays = Day(DateSerial(.Range("A1").Value, .Range("B1").Value + 1, 1) - 1)
End With
End Sub
Sheet Structure:
Is there a batter way to calculate days?
you could use:
DateValue() function to build a date out of a string you compose with your year and month values and adding any valid day number (I chose "1" to be sure...)
EOMONTH() worksheet function to get the last day of the resulting date month:
like follows:
With someSheet
...
nb_days = Day(WorksheetFunction.EoMonth(DateValue(.Range("A1").Value & " " & .Range("B1").Value & " 1"), 0))
...
End With
I suggest to use the UDF (User Defined Function) below.
Function MonthDays(Rng As Range) As Integer
Const Y As Integer = 1
Const M As Integer = 2
Dim Arr As Variant
Application.Volatile ' recalculates on every change
If Application.WorksheetFunction.Count(Rng) = 2 Then
Arr = Rng.Value
MonthDays = DateDiff("d", DateSerial(Arr(Y, 1), Arr(M, 1), 1), _
DateSerial(Arr(Y, 1), Arr(M, 1) + 1, 1))
End If
End Function
You can call it directly from the worksheet with a function call like =MonthDays(A1:A2) where A1 holds the year and A2 holds the month. If either is missing the function returns 0. The function accepts impossible numbers for both year and month and will return a logical result, such as the 14th month of a year being the following year's February. However, you can limit the entries by data validation.
All UDFs can be called as normal functions from your code. Cells(3, 1).Value = MonthDays(Range("A1:A2")) would have the same effect as entering the function call as described in the preceding paragraph in A3. However, if the function is called from VBA the line Application.Volatile would be not required (ineffective).
I have created a function which has 4 parameters: SearchDate, StartDate, EndDate, Events. The way I wanted the function to work was if the SearchDate is >= for some start date and =< for some end date then the function pulls the events name. For example, if the search was June 17 and the start/end date was June 15/June 18 then it would pull the event.
However the code doesn't seem to work; when I try to use it gives me a value error. I have posted the code and a table, that the function is based on, below.
Function Calendar_Events(SearchDate As Date, StartColumn As Range, EndColumn As Range, EventsColumn As Range)
Dim x As Long
Dim output As Range
For x = 1 To StartColumn.Cells.CountLarge
If Int(StartColumn.Cells(x)) <= SearchDate And Int(EndColumn.Cells(x)) >= SearchDate Then
'in place for the case of more events then rows
If y >= 3 Then
output = output & "........"
Exit For
End If
output = output & Left(EventsColumn.Cells(x), 20) & vbNewLine
y = y + 1
End If
Next x
End Function
Table:
Start Date End Date Event
1/12/2018 1/19/2018 Software Sale
1/31/2018 1/31/2018 Dinner Party
2/1/2018 2/1/2018 Baby Shower
2/12/2018 2/16/2018 Team Retreat
2/15/2018 2/16/2018 Bank Meetings
2/15/2018 2/15/2018 Lunch Date
2/15/2018 2/15/2018 Dinner Date
3/26/2018 3/29/2018 Vacation
3/28/2018 3/29/2018 Swimming
3/28/2018 3/28/2018 Mountain Biking
3/29/2018 3/29/2018 Put away clothes
3/29/2018 4/4/2018 Cottage
4/2/2018 4/2/2018 Family Photo
4/2/2018 4/4/2018 Software Sale
4/2/2018 4/6/2018 Hire Nanny
4/6/2018 4/6/2018 Day Off
1. In order to return a value from a Function you must set the Function name equal to what you want to return.
So at the end of your code you need:
Calendar_Events = output
So it knows to return the output variable you've been building.
2. Furthermore your output variable should be String. You are not collecting Ranges here, but rather the values inside of cells that match your criteria, so:
Dim Output As String
3. Also, there is no need to convert the cell values containing dates to integers. You are comparing dates to dates and that is good to go without converting. so:
If StartColumn.Cells(x).Value <= SearchDate And EndColumn.Cells(x).Value >= SearchDate Then
I've also added .value to the end of the Cell() reference. It will default to the .value property of the cell, but I'm a big fan of explicit coding instead of just hoping the compiler will know which property you meant.
4. Lastly (and optionally) you should declare the TYPE of the return from the function in the function definition. so:
Function Calendar_Events(SearchDate As Date, StartColumn As Range, EndColumn As Range, EventsColumn As Range) As String
All of this together:
Function Calendar_Events(SearchDate As Date, StartColumn As Range, EndColumn As Range, EventsColumn As Range) As String
Dim x As Long
Dim output As String
For x = 1 To StartColumn.Cells.CountLarge
Debug.Print StartColumn.Cells(x).Value, EndColumn.Cells(x).Value
If StartColumn.Cells(x).Value <= SearchDate And EndColumn.Cells(x).Value >= SearchDate Then
'in place for the case of more events then rows
If y >= 3 Then
output = output & "........"
Exit For
End If
output = output & Left(EventsColumn.Cells(x), 20) & vbNewLine
y = y + 1
End If
Next x
Calendar_Events = output
End Function
I am trying to model the cost of my home heating unit. I have 3.15 years of hourly data. I calculated cost per hour, cost per day, cost per month, and cost per year. I want to write two VBA function, one called CostPerDay and the other called CostPerMonth in order to simplify the process when I add more data. I have attached a picture of my data.
Picture of Data
The function I wrote for Cost Per Day is:
=SUM(OFFSET($M$18,(ROW()-18)*24,0,24,1))
The function I wrote for Cost Per Month is:
Jan-13 =SUM(OFFSET($P$18,(ROW()-18)*31,0,31,1))
Feb-13 =SUM(OFFSET($P$49,(ROW()-19)*28,0,28,1))
Mar-13 =SUM(OFFSET($P$77,(ROW()-20)*31,0,31,1))
Etc...
In case you need the whole range of data:
Cost Per Hour - M18:M27636
Cost Per Day - P18:P1168
Cost Per Month - S18:S55
Average Cost Per Month - V18:V29
This is what I was trying. As you can see, I am new to VBA. In the first attempt, I was trying to use Dim to define where the data was located in the spreadsheet and which cell I wanted the calculation in. I got stuck because I couldn't insert the =SUM(OFFSET($M$18,(ROW()-18)*24,0,24,1))function into VBA. I then was trying to make get rid of the hard-coded $M$18by replacing it with Cells(Match(Day,O18:O1168)+17,"P"). But none of it worked.
The second one I was playing with dialogue boxes, but I don't think I want to use them.
In the third attempt I was trying to calculate Cost Per Month. I don't have it because I didn't save it. I was using SUMIFSto match Months with the number of days in the month. That may have been my closest attempt but it still didn't work.
Function CostPerDay(BeginningCostPerDay, OutputCell)
Dim BeginningCostPerDay, OutputCell
BeginningCostPerDay = WorksheetFunction.DSum()
OutputCell = ActiveCell.Offset(3, -3).Activate
End Function
Function CostPerDay1()
Dim myValue1 As Variant, myValue2 As Variant
myValue1 = InputBox("Where do you want the data put?")
myValue2 = InputBox("What is the beginning Cost Per Day")
Range("myValue1").Value = myValue1
Range("myValue2").Value = myValue2
End Function
What if you added a helper column that started with 1 in cell A1 for example. Second row (A2) would be =If(A1=24,1,A1+1). Column B would have the hourly data. Column C or C1 would say =If(and(A1=24,A2=1),B1,B1+B2)). I didn't test, but I think this should work with perhaps a tweak.
Here's your answer.
Private Sub SumCosts(ByVal MainColumn As String, ByVal CostColumn As String, ByVal FirstDataRow As Long, Optional ByVal BracketType As Byte)
'
'Parameters:
'MainColumn: the columns with dates or months.
'CostColumn: the column that holds the costs to sum.
'FirstDataRow: the first row where the data starts
'BracketType: either 0 for hours or 1 for months
'
'This procedure assumes that in the data on the sheet
'- every hour of every day in the hours columns
'- every day of a month is present in the days columns
'are present. I.e. All hours of all 31 days of January are persent
'in the 'Date' column before the hours of February start and all days of January
'are present in the 'Month' column before the days of February start.
Const Hours As Byte = 24
'
Dim Cel As Range
Dim I As Long
Dim J As Long
Dim K As Long
Dim Rng As String
Dim Bracket As Byte
Dim Days As Byte
'
'Clean the target area, so the modle can be reused time after time.
Set Cel = Range(MainColumn & Application.Rows.Count).Offset(0, 1)
Rng = Split(Cel.Address, "$")(1)
Rng = (Rng & FirstDataRow & ":" & Rng & Cel.End(xlUp).Row)
Range(Rng).ClearContents
'
J = FirstDataRow
For Each Cel In Range(MainColumn & ":" & MainColumn)
If Cel.Value = vbNullString Then Exit For
If Cel.Row > (FirstDataRow - 1) Then
'Number of days in a month. Since this fluctuates the bracket fluctuates.
Days = DateSerial(Year(Cel.Value), Month(Cel.Value) + 1, 1) - DateSerial(Year(Cel.Value), Month(Cel.Value), 1)
Bracket = IIf(BracketType = 0, Hours, Days) 'Select the bracket to use.
K = ((Cel.Row - 1) * Bracket) + (FirstDataRow - 1) 'Determine where to stop calculating for a given day or month.
For I = J To K
Cel.Offset(0, 1).Value = Cel.Offset(0, 1).Value + Range(CostColumn & I).Value 'Do the calculation.
Next
J = K + 1 'Next loop we must pick up where we left off.
End If
Next
End Sub
Public Sub LaunchCostCalculations()
SumCosts "O", "M", 2, 0
SumCosts "R", "P", 2, 1
End Sub
Create a button in your sheet to launch LaunchCostCalculations and Bob's your uncle.
I am new to VBA and am working an a macro that will help me transform call records into something useful for analysis.
Column E contains the Date of Call which is formatted YYYYMMDD. I need to convert to MM/DD/YYYY. (i.e. 20140101 convert to 1/1/2014)
Column F contains the Time of Call which is formatted HHMMSS or HMMSS depending on whether the hour has two digits or one. I need to convert to HH:MM:SS (i.e. 130101 or 90101 which needs to convert to 13:01:01 and 9:01:01, respectively). Because the hour is missing the tens digit if the value is below ten, (below) I have added a "0" to the beginning of the value so I can use the date function.
I currently enter the the following formula in Column K and autofill until the end of the range:
=DATE(LEFT(E2,4),MID(E2,5,2),RIGHT(E2,2))+TIME(LEFT(IF(LEN(F2)=5, 0&F2, F2),2),MID(IF(LEN(F2)=5, 0&F2, F2),3,2),RIGHT(IF(LEN(F2)=5, 0&F2, F2),2))
The formula results in a value like "1/1/2013 13:01:01".
Can someone help me write the VBA code to automate this process?
Thank you.
Created separate UDFs for this. Paste the following into a module.
Function MorphDate(DateRng As Range)
Dim DateStr As String: DateStr = DateRng.Value
Dim Yr As String, Mt As String, Dy As String
Yr = Left(DateStr, 4)
Mt = Mid(DateStr, 5, 2)
Dy = Right(DateStr, 2)
MorphDate = Format(DateSerial(Yr, Mt, Dy), "m/dd/yyyy")
End Function
Function MorphTime(TimeRng As Range)
Dim TimeStr As String: TimeStr = TimeRng.Value
Dim Hh As String, Mm As String, Ss As String
If Len(TimeStr) = 5 Then TimeStr = "0" & TimeStr
Hh = Left(TimeStr, 2)
Mm = Mid(TimeStr, 3, 2)
Ss = Right(TimeStr, 2)
MorphTime = Format(TimeSerial(Hh, Mm, Ss), "hh:mm:ss")
End Function
Function MorphDateTime(DateRng As Range, TimeRng As Range)
Application.Volatile
MorphDateTime = CDate(MorphDate(DateRng)) + CDate(MorphTime(TimeRng))
End Function
Now you can use the formulas MorphDate to change the date, MorphTime to change the time, and MorphDateTime for a combination of both.
Screenshot:
Let us know if this helps.
EDIT:
If you want to use it inside a subroutine, add the following code to the module:
Sub MorphingTime()
Dim DateRng As Range, Cell As Range
Set DateRng = Range("E2:E100") '--Modify as needed.
For Each Cell in DateRng
Range("K" & Cell.Row).Value = MorphDateTime(Cell, Cell.Offset(0,1))
Next Cell
End Sub
Hope this helps.