I was looking for an answer however I failed.
I wrote following code that basically adds a new row to the table and adds a current week number in 1st cell of new row:
Set table = Workbooks("EMEA Day 2 Chasing Audit Master Report.xlsm").Worksheets("Team Stats").ListObjects.Item("TableLilla")
Set oLastrowStats = Workbooks("EMEA Day 2 Chasing Audit Master Report.xlsm").Worksheets("Team Stats").ListObjects("TableLilla").ListRows.Add
Worksheets("Team Stats").ListObjects("TableLilla").ListColumns(1).DataBodyRange(oLastrowStats.Index, 1).Value = "W" & WorksheetFunction.WeekNum(Now, vbMonday)
The weird part starts here: the code works as it should on 2 computers but it does not on third one. On the 3rd computer, new row is added but the 3rd code line doesn't insert a week number.
I'm pretty sure it is related with this particular notebook, however have no clue where to look for solution. I didn't notice any major differences in Excel Settings. I've also checked the Win10 regional and date set up and they are the same as on my notebook.
Do you have any clue how to sort this out?
Thanks!
Try using a function that returns the ISO 8601 week number (and year):
' Constants.
Public Const MaxWeekValue As Integer = 53
Public Const MinWeekValue As Integer = 1
Public Const MaxMonthValue As Integer = 12
Public Const MinMonthValue As Integer = 1
' Returns the ISO 8601 week of a date.
' The related ISO year is returned by ref.
'
' 2016-01-06. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function Week( _
ByVal Date1 As Date, _
Optional ByRef IsoYear As Integer) _
As Integer
Dim Month As Integer
Dim Interval As String
Dim Result As Integer
Interval = "ww"
Month = VBA.Month(Date1)
' Initially, set the ISO year to the calendar year.
IsoYear = VBA.Year(Date1)
Result = DatePart(Interval, Date1, vbMonday, vbFirstFourDays)
If Result = MaxWeekValue Then
If DatePart(Interval, DateAdd(Interval, 1, Date1), vbMonday, vbFirstFourDays) = MinWeekValue Then
' OK. The next week is the first week of the following year.
Else
' This is really the first week of the next ISO year.
' Correct for DatePart bug.
Result = MinWeekValue
End If
End If
' Adjust year where week number belongs to next or previous year.
If Month = MinMonthValue Then
If Result >= MaxWeekValue - 1 Then
' This is an early date of January belonging to the last week of the previous ISO year.
IsoYear = IsoYear - 1
End If
ElseIf Month = MaxMonthValue Then
If Result = MinWeekValue Then
' This is a late date of December belonging to the first week of the next ISO year.
IsoYear = IsoYear + 1
End If
End If
' IsoYear is returned by reference.
Week = Result
End Function
Like this:
Worksheets("Team Stats").ListObjects("TableLilla").ListColumns(1).DataBodyRange(oLastrowStats.Index, 1).Value = "W" & Week(Date)
Related
I have written some code which I then use in a message box to take the current date/time and i then choose how many days/hours/min to add to current date and time and it pops up.
If i only chose day as 1 extra it works perfect but the moment i chose 1 day and 1 hour then it adds 2 days to the date. If i say 1 day, 1 hour and 1 min then it adds 3 days to current date/time.
Here is my function code
Function HoursLost()
Dim Day As Date
Dim Hour As Date
Dim Minute As Date
Dim LValue As Date
LValue = Now
Day = InputBox("Enter Day ", "Enter Number of Days")
Hour = InputBox("Enter Hour", "Enter Number of Hours")
Minute = InputBox("Enter Minute", "Enter Number of Minutes")
HoursLost = Now + Day + Hour + Minute
End Function
And here is my code to call the box
Option Explicit
Sub ShowDateSelection(control As IRibbonControl)
Dim strMsg As String, strTitle As String
Application.Calculate
strMsg = HoursLost()
strTitle = "The Future Date/Time Will Be:"
MsgBox strMsg, vbOKOnly, strTitle
End Sub
Any advise on how to get around this? PS - I use this in a custom ribbon hence the ribbon part.
One way to go about this is with the DateAdd function. Replace the following:
HoursLost = Now + Day + Hour + Minute
with something like this:
HoursLost = DateAdd("d", Day, Now)
HoursLost = DateAdd("h", Hour, HoursLost)
HoursLost = DateAdd("n", Minute, HoursLost)
**Hello all,
I have a question that is ½ about the code and ½ about the logic behind the code.
Background:
This is a vary small part of one Sub in a large workbook collection. The goal of this bit of code is to accept a user input for the number of business days they want to look out for a date range. Determine if the dates between contain weekend days, if so, add 2 to the range. The input is data type Integer. The number is added to the current date to get the last date in the range and assigned to dDate for use in this and other Sub’s.
What the code should do:
The most a user can request to look out for is 14 (don’t need error handling for more then 14). The request can be made any day of the week including weekends. If a request is made on Wednesday to look out 3 business days, the program should add 2 to show Thursday, Friday, Saturday, Sunday, and Monday. If the request is made on a Saturday to show 2 business days the program should add 1 to show Sunday, Monday, and Tuesday. If the number requested has 2 weekends between the range (8-14) then add 4.
So in short, for every weekend day in the date range, add one day to the user input number.
Please explain any responses with in code comments for all VBA skill levels.
Both Code and logic help is welcome.
**
'prompt to enter number of days to look out for shortage, new addition to the code added to expand usability
iNumDays = Application.InputBox(prompt:="Enter number of business days to look out for")
iweekday = Weekday(Date, vbMonday) 'get todays weekday number 1-7 with Monday being 1, Sunday being 7
'if today is Thursday or Friday the next 2 business days fall on the weekend, if so then we need to look out 2 days more
If iweekday > 3 Then 'iweekday is integer of todays weekday number, if its past Wednesday then enter If
iNumDays = iNumDays + 2 'add 2 to user input
End If
dDate = Date + iNumDays 'add user day to look out input to todays date to get last date in desired date range 'get the column header for the date we are looking out to
Solution found here: https://www.experts-exchange.com/questions/23461938/VB-net-Add-Days-to-a-Date.html
Public Function AddNBusinessDays(ByVal startDate As DateTime, ByVal numDays As Integer) As DateTime
If numDays = 0 Then Return New DateTime(startDate.Ticks)
If numDays < 0 Then Throw New ArgumentException()
Dim i As Integer
Dim totalDays As Integer
Dim businessDays As Integer
totalDays = 0
businessDays = 0
Dim currDate As DateTime
While businessDays < numDays
totalDays += 1
currDate = startDate.AddDays(totalDays)
If Not (currDate.DayOfWeek = DayOfWeek.Saturday Or currDate.DayOfWeek = DayOfWeek.Sunday) Then
businessDays += 1
End If
End While
Return currDate
End Function
The most intuitive way to do this (in my opinion) is to simply count the days forward one by one until you added as many work days as requested by the user. The 14 days limit is not necessary anyways, as it is a loop that works with any integer up to billions of days...
Sub adddays()
Dim iNumDays As Integer
Dim iWeekDay As Integer
Dim dDate As Date
'prompt to enter number of days to look out for shortage, new addition to the code added to expand usability
iNumDays = Application.InputBox(prompt:="Enter number of business days to look out for")
dDate = Date ' initialize dDate with today's date before entering the counting loop
While iNumDays > 0 ' as long as the there are still workdays left to add, repeat this
dDate = dDate + 1 ' move calendar forward by one day
iWeekDay = Weekday(dDate, vbMonday) ' check what weekday we arrived at
If iWeekDay < 6 Then ' if we're looking at a working day, we successfully added one of the desired weekdays to be added
iNumDays = iNumDays - 1
End If
Wend
MsgBox ("Target date is: " & Str(dDate)) 'check results of the calculation or replace with whatever other logic you want here
End Sub
I am making a function that will search through a range and find the oldest date (the oldest date is in last row with data). My range is structured as following and I won't be able to change this structure:
Year Month Day
yyyy mm dd
So the year month and day are seperated in three different columns.
My code is as following:
Function OLDEST(yearrng As Range) As Variant
Dim lastrow As Long
Dim year, month, day As String
lastrow = Range(yearrng).SpecialCells(xlCellTypeBlanks).Row
year = Range("I" & lastrow).value
month = year.Offset(0, 1).value
day = year.Offset(0, 2).value
OLDEST = year & month & day
End Function
The yearrng is the same range which the years are displayed.
The problem is that this function is not working and is returning "value error"...
I hope you understood my question.
Thanks!
For a non-volatile worksheet function, you can try:
=DATE(LOOKUP(2,1/(LEN($I:$I)>0),I:I),LOOKUP(2,1/(LEN($I:$I)>0),J:J),LOOKUP(2,1/(LEN($I:$I)>0),K:K))
where I is the column to test for which is the "bottom" row, and I, J, and K are the columns with the relevant date parts.
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.
The code from Søren Holten Hansen under This post actually has part of my answer, but not completely.
I need to split dates along with their respective duration.
example:
Begin Date End Date Duration
3-Nov 5-Nov 2.5
I need it to look like this:
3-Nov 1
4-Nov 1
5-Nov 0.5
I need the half day to be shown on the last day. I am not sure how to make this split.
Appreciate the help this forum provides. This will really save my life!!!
my code:
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[-4]=R[-1]C[-4],RC[-4]=R[1]C[-4]),R[-1]C[-2]-R[-1]C, IF(R[-1]C[-2]=R[-1]C,R[-1]C[-2], R[-1]C[-2]))"
Range("E21").Select
Thank you,
Marvin.
Following code may help to solve your problem.
'Function print_date
' 1st argument: date of period begin
' 2nd argument: date of period end
' 3rd argument: duration in days
'
' CAUTION: This code does not check consistency between dates and duration.
' If you set duration 1.5 between Nov-3 to Nov-5, this code raise no error
' and you may see duration -0.5 on Nov-5.
Function print_date(beginDay, endDay, duration) As Integer
Dim aDay As Date
Dim row As Integer
row = 1
For aDay = beginDay To endDay
Cells(row, 1) = aDay 'set date on first column
If duration > 1# Then
Cells(row, 2) = 1 'set 1 on second column because more one day left.
Else 'Duration is less than one day
Cells(row, 2) = duration
End If
duration = duration - 1#
row = row + 1
Next aDay
End Function
' Test routine I checked operation of print_date.
Sub test_print_date()
Dim a As Long
a = print_date(DateValue("2014/11/03"), DateValue("2014/11/05"), 2.5)
End Sub
You may see the output on the cells A1:B3 when you run 'test_print_date()' of avobe code.