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).
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)
I am trying to create a function or functions that can sum daily hours from time cards for each client to come up with the total hours worked per day. Each client has it's own sheet inside of a single workbook.
Currently, I have a function that determines the sheet that goes with the first client (the third sheet in the workbook):
Function FirstSheet()
Application.Volatile
FirstSheet = Sheets(3).Name
End Function
And one to find the last sheet:
Function LastSheet()
Application.Volatile
LastSheet = Sheets(Sheets.Count).Name
End Function
The part that I am having trouble with it getting these to work within the sum function.
=sum(FirstSheet():LastSheet()!A1
That is basically what I want to accomplish. I think the problem is that I don't know how to concatenate it without turning it into a string and it doesn't realize that it is sheet and cell references.
Any help would be greatly appreciated.
So, an example formula would look like this:
=SUM(Sheet2!A1:A5,Sheet3!A1:A5,Sheet4!A1:A5)
That would sum Sheet2-Sheet4, A1:A5 on all sheets.
Is there a reason you need to write the VBA code to do this?
Can't you just enter it as a formula once?
Also, if you're going to the trouble of writing VBA to generate a formula, it may make more sense to just do the sum entirely in VBA code.
If not, try this:
Sub GenerateTheFormula()
Dim x, Formula
Formula = "=SUM(" 'Formula begins with =SUM(
For x = 3 To Sheets.Count
Formula = Formula & Sheets(x).Name & "!A1," 'Add SheetName and Cell and Comma
Next x
Formula = Left(Formula, Len(Formula) - 1) & ")" 'Remove trailing comma and add parenthesis
Range("B1").Formula = Formula 'Where do you want to put this formula?
End Sub
Results:
The functions return strings and not actual worksheets. The Worksheet does not parse strings well. So add a third function that uses the Evaluate function:
Function MySum(rng As Range)
MySum = Application.Caller.Parent.Evaluate("SUM(" & FirstSheet & ":" & LastSheet & "!" & rng.Address & ")")
End Function
Then you would simply call it: MySum(A1)
It uses the other two function you already have created to create a string that can be evaluated as a formula.
I didn't understand ur question completely but As I understood u have different sheets of different clients which contains supoose column 1 date and column 2
contains hours on that particular date wise hours and a final sheet which column1 contains name of client and column 2 contains total hoursPlease try it
Sub countHours()
Dim last_Row As Integer
Dim sum As Double
sum = 0
'Because I know number of client
For i = 1 To 2 'i shows client particular sheet
last_Row = Range("A" & Rows.Count).End(xlUp).Row
Sheets(i).Activate
For j = 2 To last_Row
'In my Excel sheet column 1 contains dates and column 2 contains number of hours
sum = sum + Cells(j, 2)
'MsgBox sum
Next j
'Sheet 3 is my final sheet
ThisWorkbook.Sheets(3).Cells(i + 1, 2).Value = sum
sum = 0
Next i
End Sub
Happy Coding :
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 have a puzzle I've been trying to solve for ages now, but it's quite simply beyond me.
I have a spreadsheet with 3 columns. Column A is instructor ID numbers, Column B is their course Start date and Column C is their course end date. There are multiple courses for each instructor ID.
I'm basically trying to answer the question, what is the maximum number of courses this instructor is teaching at any given time.
Essentially, I need to find, for each ID number, the number of maximum, concurrent, overlapping date ranges.
The trouble is, while I know how to find overlapping date ranges, I don't know how to count the number of concurrent courses.
Eg.
Instructor 115 has the following date ranges listed:
9/10/13 / 11/04/13
9/17/13 / 11/11/13
11/05/13 / 12/30/13
11/12/13 / 1/20/14
While the 11/05/13 course overlaps with both the 9/17/13 course and the 11/12/13 course, they do not overlap with each other... so this instructor is only teaching a maximum of 2 courses at any time.
Is there a way to write a function that will return the highest number of concurrent overlapping date ranges for each ID?
Edit not form OP to transfer details from a comment:
I can solve this geometrically, but I don't know how to do that in a VBA function (I'm still very new to programming). If I were to solve this outside of code, I would create a table for each ID making a column for every day. I'd then create a row for each date range, marking a 1 in each column that range overlaps with. then I’d sum the total overlaps for each day. Then I’d use a simple MAX function to return the highest number of consecutive overlaps. Is there a way to do this inside of a function without having Excel physically draw out these tables?
Using VBA, assuming Column A contains your start dates, and column B contains your end dates, and assuming your data starts in row 1 and there are no blank rows in your data, the below sub will do what you outlined in your comment:
Sub getMaxConcurrent()
'get minimum date (startDate)
Dim startDateRange
Set startDateRange = Range("A1", Range("A1").End(xlDown))
Dim startDate As Date
startDate = WorksheetFunction.Min(startDateRange)
'get maximum date (endDate)
Dim endDateRange
Set endDateRange = Range("B1", Range("B1").End(xlDown))
Dim endDate As Date
endDate = WorksheetFunction.Max(endDateRange)
'get date range (dateInterval)
Dim dateInterval As Integer
dateInterval = DateDiff("d", startDate, endDate)
'Create daily table header
Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Dim x As Integer
For x = 0 To dateInterval
Dim dateVal As Date
dateVal = DateAdd("d", startDate, x)
Cells(1, 3 + x).Value = dateVal
Next
'Fill in daily table
Dim y As Integer
y = 2
Dim startDateValue As Date
startDateValue = Cells(y, 1).Value
Do Until IsEmpty(Cells(y, 1).Value)
For x = 3 To dateInterval + 3
If (Cells(y, 1).Value <= Cells(1, x).Value) Then
If (Cells(y, 2).Value >= Cells(1, x).Value) Then
Cells(y, x).Value = 1
Else
Cells(y, x).Value = 0
End If
Else
Cells(y, x).Value = 0
End If
Next
y = y + 1
Loop
'sum up each day
For x = 3 To dateInterval + 3
Cells(y, x).Value = WorksheetFunction.Sum(Range(Cells(2, x).Address & ":" & Cells(y - 1, x).Address))
Next
MsgBox ("Max concurrent courses: " & WorksheetFunction.Max(Range(Cells(y, 3).Address & ":" & Cells(y, x).Address)))
End Sub
If you have data down to row 1000 then this "array formula" will give the maximum number of concurrent courses for an Instructor ID in E2
=MAX(COUNTIFS(A:A,E2,B:B,"<="&B$2:C$1000,C:C,">="&B$2:C$1000))
confirmed with CTRL+SHIFT+ENTER
Let's assume there is only one instructor and you have start and end dates in A1:B4.
Copy A1:A4 to A7:A10, copy B1:b4 to A11:a14 (right under it). Select A7:A14, hit Sort (on data tab) and "remove duplicates". You have a list unique list of dates in ascending order. Let's assume there were no duplicates (as in your example), your of date is same A7:a14. Select it copy, and paste spacial with transpose to C5.
At this point You have start and end dates in A1:B4 and list of uniqe dates in C5:J5. Put formula =IF(AND($A1<=C$5,C$5<=$B1),1,0) in C1 and copy it to C1:J4.
put formula =SUM(C1:C4) in C6 and copy it to C6:J6.
Maximum number in C6:j6 is your maximum concurrent courses for this instructor
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