Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
anyone have any improvements for my Weeks Function?
I just thought I might post this function I created to get what week number it is if a businesses week starts on a Sunday. I am a bit of a "hack" programmer and came up with this after days of trial and error, and would love if any professional out there could let me know if it is "hilarious" or "ingeniuos" or any improvements anyone might have. This works only for the Year 2000 and above (at least to 2100). Here is the code Function GetWeeksBeginningSunday() Dim hold, holdYear, slashPosition, holdMonth, monthAndYearOnly, holdDay, holdLen As String Dim intweek, daysUpToCurrent, January, February, March, April, May, June, July, August, September, October, November, December As Integer Dim daysBeforeFebruary, daysBeforeMarch, daysBeforeApril, daysBeforeMay, daysBeforeJune As Integer Dim daysBeforeJuly, daysBeforeAugust, daysBeforeSeptember, daysBeforeOctober, daysBeforeNovember, daysBeforeDecember As Integer Dim decweek As Double Dim daysLeftInStartofYearWeek, days, i, afterLeapyear As Integer Dim tempDate As String tempDate = Date holdYear = Right(tempDate, 4) holdYear = holdYear - 2000 holdLen = Len(tempDate) slashPosition = InStr(1, tempDate, "/", 1) holdMonth = Left(tempDate, slashPosition - 1) monthAndYearOnly = Right(tempDate, holdLen - slashPosition) slashPosition = InStr(1, monthAndYearOnly, "/", 1) holdDay = Left(monthAndYearOnly, slashPosition - 1) afterLeapyear = 5 daysLeftInStartofYearWeek = 7 If holdYear = 0 Then daysLeftInStartofYearWeek = 1 Else For i = 1 To holdYear If daysLeftInStartofYearWeek = 1 Then daysLeftInStartofYearWeek = 8 End If If i = afterLeapyear Then afterLeapyear = afterLeapyear + 4 daysLeftInStartofYearWeek = daysLeftInStartofYearWeek - 2 Else daysLeftInStartofYearWeek = daysLeftInStartofYearWeek - 1 End If Next i End If If holdYear Mod 4 = 0 Then February = 29 days = 366 Else February = 28 days = 365 End If January = 31 March = 31 April = 30 May = 31 June = 30 July = 31 August = 31 September = 30 October = 31 November = 30 December = 31 daysBeforeFebruary = January daysBeforeMarch = daysBeforeFebruary + February daysBeforeApril = daysBeforeMarch + March daysBeforeMay = daysBeforeApril + April daysBeforeJune = daysBeforeMay + May daysBeforeJuly = daysBeforeJune + June daysBeforeAugust = daysBeforeJuly + July daysBeforeSeptember = daysBeforeAugust + August daysBeforeOctober = daysBeforeSeptember + September daysBeforeNovember = daysBeforeOctober + October daysBeforeDecember = daysBeforeNovember + November Select Case holdMonth Case 1 daysUpToCurrent = holdDay Case 2 daysUpToCurrent = daysBeforeFebruary + holdDay Case 3 daysUpToCurrent = daysBeforeMarch + holdDay Case 4 daysUpToCurrent = holdDay + daysBeforeApril Case 5 daysUpToCurrent = holdDay + daysBeforeMay Case 6 daysUpToCurrent = holdDay + daysBeforeJune Case 7 daysUpToCurrent = holdDay + daysBeforeJuly Case 8 daysUpToCurrent = holdDay + daysBeforeAugust Case 9 daysUpToCurrent = holdDay + daysBeforeSeptember Case 10 daysUpToCurrent = holdDay + daysBeforeOctober Case 11 daysUpToCurrent = holdDay + daysBeforeNovember Case 12 daysUpToCurrent = holdDay + daysBeforeDecember End Select daysUpToCurrent = CInt(daysUpToCurrent) If daysUpToCurrent <= daysLeftInStartofYearWeek Then GetWeeksBeginningSunday = 1 Else decweek = ((daysUpToCurrent - (daysLeftInStartofYearWeek + 1)) / 7) + 2 intweek = CInt(decweek) If intweek decweek Then intweek = intweek - 1 End If GetWeeksBeginningSunday = intweek End If End Function ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~View and post usenet messages directly from http://www.ExcelForum.com/ ~~Now Available: Financial Statements.xls, a step by step guide to creating financial statements |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
anyone have any improvements for my Weeks Function?
Hi,
I think there are a few built-in VBA functions that might save some work. If I am right in thinking that the function works out what week of the year we are in (i.e. week 48 at the moment I think), the following should do the job:- Function GetWeeks() GetWeeks = DateDiff("ww",DateSerial(CInt(Year(Date)),1,1),Dat e,vbSunday,vbFirstJan1) End Function The DateDiff function works out the number of specified intervals between two dates. The "ww" string specifies that we want to know the number of weeks and Date, obviously, is just today's date. The DateSerial(CInt(Year(Date)),1,1) bit just takes the year from the current date, converts it to an integer, and then uses the DateSerial function to construct the first of january in the current year. The two parameters on the end (vbSunday and vbFirstJan1) just specify a couple of things about how we want the dates calculated (e.g. first day of the week etc.). Don't know if that's any help! Regards, James. "reesmacleod" wrote in message ... I just thought I might post this function I created to get what week number it is if a businesses week starts on a Sunday. I am a bit of a "hack" programmer and came up with this after days of trial and error, and would love if any professional out there could let me know if it is "hilarious" or "ingeniuos" or any improvements anyone might have. This works only for the Year 2000 and above (at least to 2100). Here is the code Function GetWeeksBeginningSunday() Dim hold, holdYear, slashPosition, holdMonth, monthAndYearOnly, holdDay, holdLen As String Dim intweek, daysUpToCurrent, January, February, March, April, May, June, July, August, September, October, November, December As Integer Dim daysBeforeFebruary, daysBeforeMarch, daysBeforeApril, daysBeforeMay, daysBeforeJune As Integer Dim daysBeforeJuly, daysBeforeAugust, daysBeforeSeptember, daysBeforeOctober, daysBeforeNovember, daysBeforeDecember As Integer Dim decweek As Double Dim daysLeftInStartofYearWeek, days, i, afterLeapyear As Integer Dim tempDate As String tempDate = Date holdYear = Right(tempDate, 4) holdYear = holdYear - 2000 holdLen = Len(tempDate) slashPosition = InStr(1, tempDate, "/", 1) holdMonth = Left(tempDate, slashPosition - 1) monthAndYearOnly = Right(tempDate, holdLen - slashPosition) slashPosition = InStr(1, monthAndYearOnly, "/", 1) holdDay = Left(monthAndYearOnly, slashPosition - 1) afterLeapyear = 5 daysLeftInStartofYearWeek = 7 If holdYear = 0 Then daysLeftInStartofYearWeek = 1 Else For i = 1 To holdYear If daysLeftInStartofYearWeek = 1 Then daysLeftInStartofYearWeek = 8 End If If i = afterLeapyear Then afterLeapyear = afterLeapyear + 4 daysLeftInStartofYearWeek = daysLeftInStartofYearWeek - 2 Else daysLeftInStartofYearWeek = daysLeftInStartofYearWeek - 1 End If Next i End If If holdYear Mod 4 = 0 Then February = 29 days = 366 Else February = 28 days = 365 End If January = 31 March = 31 April = 30 May = 31 June = 30 July = 31 August = 31 September = 30 October = 31 November = 30 December = 31 daysBeforeFebruary = January daysBeforeMarch = daysBeforeFebruary + February daysBeforeApril = daysBeforeMarch + March daysBeforeMay = daysBeforeApril + April daysBeforeJune = daysBeforeMay + May daysBeforeJuly = daysBeforeJune + June daysBeforeAugust = daysBeforeJuly + July daysBeforeSeptember = daysBeforeAugust + August daysBeforeOctober = daysBeforeSeptember + September daysBeforeNovember = daysBeforeOctober + October daysBeforeDecember = daysBeforeNovember + November Select Case holdMonth Case 1 daysUpToCurrent = holdDay Case 2 daysUpToCurrent = daysBeforeFebruary + holdDay Case 3 daysUpToCurrent = daysBeforeMarch + holdDay Case 4 daysUpToCurrent = holdDay + daysBeforeApril Case 5 daysUpToCurrent = holdDay + daysBeforeMay Case 6 daysUpToCurrent = holdDay + daysBeforeJune Case 7 daysUpToCurrent = holdDay + daysBeforeJuly Case 8 daysUpToCurrent = holdDay + daysBeforeAugust Case 9 daysUpToCurrent = holdDay + daysBeforeSeptember Case 10 daysUpToCurrent = holdDay + daysBeforeOctober Case 11 daysUpToCurrent = holdDay + daysBeforeNovember Case 12 daysUpToCurrent = holdDay + daysBeforeDecember End Select daysUpToCurrent = CInt(daysUpToCurrent) If daysUpToCurrent <= daysLeftInStartofYearWeek Then GetWeeksBeginningSunday = 1 Else decweek = ((daysUpToCurrent - (daysLeftInStartofYearWeek + 1)) / 7) + 2 intweek = CInt(decweek) If intweek decweek Then intweek = intweek - 1 End If GetWeeksBeginningSunday = intweek End If End Function ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~View and post usenet messages directly from http://www.ExcelForum.com/ ~~Now Available: Financial Statements.xls, a step by step guide to creating financial statements |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
anyone have any improvements for my Weeks Function?
Reesmacleod wrote:
I am a bit of a "hack" programmer and came up with this after days of trial and error, and would love if any professional out there could let me know if it is "hilarious" or "ingeniuos" or any improvements anyone might have. Firstly the code only works if your dates are formatted as m/d/y so it typically won't work outside the USA. My go would be Function GetWeekNumber(DT As Date) As Integer Dim FirstSunOfYear As Date FirstSunOfYear = DateSerial(Year(DT),1,1) + 7 - _ WeekDay(DateSerial(Year(DT),1,1), vbMonday) If DT < FirstSunOfYear Then ' end of last year FirstSunOfYear = DateSerial(Year(DT)-1,1,1) + 7 - _ WeekDay(DateSerial(Year(DT)-1,1,1), vbMonday) End If GetWeekNumber = (DT - FirstSunOfYear) \ 7 + 1 End Function You can call it from a worksheet with =GetWeekNumber(TODAY()) or any other date as argument that you might want. Bill Manville MVP - Microsoft Excel, Oxford, England No email replies please - reply in newsgroup |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
anyone have any improvements for my Weeks Function?
On Wed, 3 Dec 2003 17:46:59 -0600, reesmacleod
wrote: I just thought I might post this function I created to get what week number it is if a businesses week starts on a Sunday. I am a bit of a "hack" programmer and came up with this after days of trial and error, and would love if any professional out there could let me know if it is "hilarious" or "ingeniuos" or any improvements anyone might have. See http://www.cpearson.com/excel/weeknum.htm for a good discussion of the issues. --ron |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
anyone have any improvements for my Weeks Function?
I think the below function is somewhat simpler and will
allow you to determine the Start Day you want to base the week function on (default is System week start date). I also tryed your function with 7/15/2050 and got a return value 30 which I think is wrong. Hope this helps, Felix Function Week(CalcDate As Date, Optional WeekStartDay As String) As Integer Dim CalcYearStart As Date Dim CalcYearStartWeekday As Integer Dim CalcWeekDay As Integer Dim WeekStartDayNum As Integer Select Case WeekStartDay Case "Sunday" WeekStartDayNum = 1 Case "Monday" WeekStartDayNum = 2 Case "Tuesday" WeekStartDayNum = 3 Case "Wednesday" WeekStartDayNum = 4 Case "Thursday" WeekStartDayNum = 5 Case "Friday" WeekStartDayNum = 6 Case "Saturday" WeekStartDayNum = 7 Case Else WeekStartDayNum = 0 End Select CalcYearStart = "1/1/" + CStr(Year(CalcDate)) CalcYearStartWeekday = Weekday(CalcYearStart, WeekStartDayNum) CalcWeekDay = Weekday(CalcDate, WeekStartDayNum) Week = (CDbl(CalcDate) - CDbl(CalcYearStart) + CalcYearStartWeekday - CalcWeekDay) / 7 + 1 End Function -----Original Message----- I just thought I might post this function I created to get what week number it is if a businesses week starts on a Sunday. I am a bit of a "hack" programmer and came up with this after days of trial and error, and would love if any professional out there could let me know if it is "hilarious" or "ingeniuos" or any improvements anyone might have. This works only for the Year 2000 and above (at least to 2100). Here is the code Function GetWeeksBeginningSunday() Dim hold, holdYear, slashPosition, holdMonth, monthAndYearOnly, holdDay, holdLen As String Dim intweek, daysUpToCurrent, January, February, March, April, May, June, July, August, September, October, November, December As Integer Dim daysBeforeFebruary, daysBeforeMarch, daysBeforeApril, daysBeforeMay, daysBeforeJune As Integer Dim daysBeforeJuly, daysBeforeAugust, daysBeforeSeptember, daysBeforeOctober, daysBeforeNovember, daysBeforeDecember As Integer Dim decweek As Double Dim daysLeftInStartofYearWeek, days, i, afterLeapyear As Integer Dim tempDate As String tempDate = Date holdYear = Right(tempDate, 4) holdYear = holdYear - 2000 holdLen = Len(tempDate) slashPosition = InStr(1, tempDate, "/", 1) holdMonth = Left(tempDate, slashPosition - 1) monthAndYearOnly = Right(tempDate, holdLen - slashPosition) slashPosition = InStr(1, monthAndYearOnly, "/", 1) holdDay = Left(monthAndYearOnly, slashPosition - 1) afterLeapyear = 5 daysLeftInStartofYearWeek = 7 If holdYear = 0 Then daysLeftInStartofYearWeek = 1 Else For i = 1 To holdYear If daysLeftInStartofYearWeek = 1 Then daysLeftInStartofYearWeek = 8 End If If i = afterLeapyear Then afterLeapyear = afterLeapyear + 4 daysLeftInStartofYearWeek = daysLeftInStartofYearWeek - 2 Else daysLeftInStartofYearWeek = daysLeftInStartofYearWeek - 1 End If Next i End If If holdYear Mod 4 = 0 Then February = 29 days = 366 Else February = 28 days = 365 End If January = 31 March = 31 April = 30 May = 31 June = 30 July = 31 August = 31 September = 30 October = 31 November = 30 December = 31 daysBeforeFebruary = January daysBeforeMarch = daysBeforeFebruary + February daysBeforeApril = daysBeforeMarch + March daysBeforeMay = daysBeforeApril + April daysBeforeJune = daysBeforeMay + May daysBeforeJuly = daysBeforeJune + June daysBeforeAugust = daysBeforeJuly + July daysBeforeSeptember = daysBeforeAugust + August daysBeforeOctober = daysBeforeSeptember + September daysBeforeNovember = daysBeforeOctober + October daysBeforeDecember = daysBeforeNovember + November Select Case holdMonth Case 1 daysUpToCurrent = holdDay Case 2 daysUpToCurrent = daysBeforeFebruary + holdDay Case 3 daysUpToCurrent = daysBeforeMarch + holdDay Case 4 daysUpToCurrent = holdDay + daysBeforeApril Case 5 daysUpToCurrent = holdDay + daysBeforeMay Case 6 daysUpToCurrent = holdDay + daysBeforeJune Case 7 daysUpToCurrent = holdDay + daysBeforeJuly Case 8 daysUpToCurrent = holdDay + daysBeforeAugust Case 9 daysUpToCurrent = holdDay + daysBeforeSeptember Case 10 daysUpToCurrent = holdDay + daysBeforeOctober Case 11 daysUpToCurrent = holdDay + daysBeforeNovember Case 12 daysUpToCurrent = holdDay + daysBeforeDecember End Select daysUpToCurrent = CInt(daysUpToCurrent) If daysUpToCurrent <= daysLeftInStartofYearWeek Then GetWeeksBeginningSunday = 1 Else decweek = ((daysUpToCurrent - (daysLeftInStartofYearWeek + 1)) / 7) + 2 intweek = CInt(decweek) If intweek decweek Then intweek = intweek - 1 End If GetWeeksBeginningSunday = intweek End If End Function ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~View and post usenet messages directly from http://www.ExcelForum.com/ ~~Now Available: Financial Statements.xls, a step by step guide to creating financial statements . |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
anyone have any improvements for my Weeks Function?
Thanks all for the input. Looks like I need to learn a lot more still. Amazing how many different ways to do the same thing and all much more concise. Thanks again Rees ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~View and post usenet messages directly from http://www.ExcelForum.com/ ~~Now Available: Financial Statements.xls, a step by step guide to creating financial statements |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
anyone have any improvements for my Weeks Function?
Would any ideas here help?
Function WeekNum(dte As Date) As Long WeekNum = Format(dte, "ww", vbSunday, vbFirstFullWeek) If Month(dte) = 1 And WeekNum 50 Then WeekNum = 0 End Function Prior to the first Sunday in January, I changed the return value of 52 to 0 (zero). Adjust if you want, or just delete the second line. There is a bug in Excel (at least XP) with this method for a specific year over 2100, but I can't find my notes right now. It normally shouldn't be a problem though. -- Dana DeLouis Using Windows XP & Office XP = = = = = = = = = = = = = = = = = "reesmacleod" wrote in message ... I just thought I might post this function I created to get what week number it is if a businesses week starts on a Sunday. I am a bit of a "hack" programmer and came up with this after days of trial and error, and would love if any professional out there could let me know if it is "hilarious" or "ingeniuos" or any improvements anyone might have. This works only for the Year 2000 and above (at least to 2100). Here is the code <snip |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
anyone have any improvements for my Weeks Function?
Dana DeLouis wrote:
Function WeekNum(dte As Date) As Long WeekNum = Format(dte, "ww", vbSunday, vbFirstFullWeek) If Month(dte) = 1 And WeekNum 50 Then WeekNum = 0 End Function Smart solution. Never noticed those extra arguments on Format - just for that purpose! I concede<g. Bill Manville MVP - Microsoft Excel, Oxford, England No email replies please - reply in newsgroup |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Overview Improvements for Excel Worksheets | Excel Discussion (Misc queries) | |||
Weeks of Supply Function | Excel Worksheet Functions | |||
Counting Consecutive Improvements | Excel Discussion (Misc queries) | |||
XY Chart Improvements For Scientific Data | Charts and Charting in Excel | |||
Improvements for text finding functions | Excel Discussion (Misc queries) |