Hello
I've made a VBA script which will colour my cells according to week numbers, with a little help from a borrowed function.
Now I've got each working week coloured - Monday - Friday - I want each week range to calculate a particular formula e.g.
Week No Start End Formula1 Formula2
1 24 25 =(SUMIF(J24:J25,">"&0))/(COUNTIF(J24:J25,">"&0)) =(SUMIF(G24:G25,">"&0))/(COUNTIF(G24:G25,">"&0))
2 26 30 =(SUMIF(J26:J30,">"&0))/(COUNTIF(J24:J25,">"&0)) =(SUMIF(G26:G30,">"&0))/(COUNTIF(G24:G25,">"&0))
3 31 35 ... ...
4 36 40
The weeks are coloured automatically according to their week number.
You can see the part I am stuck on highlighted in bold
See code below:
I've made a VBA script which will colour my cells according to week numbers, with a little help from a borrowed function.
Now I've got each working week coloured - Monday - Friday - I want each week range to calculate a particular formula e.g.
Week No Start End Formula1 Formula2
1 24 25 =(SUMIF(J24:J25,">"&0))/(COUNTIF(J24:J25,">"&0)) =(SUMIF(G24:G25,">"&0))/(COUNTIF(G24:G25,">"&0))
2 26 30 =(SUMIF(J26:J30,">"&0))/(COUNTIF(J24:J25,">"&0)) =(SUMIF(G26:G30,">"&0))/(COUNTIF(G24:G25,">"&0))
3 31 35 ... ...
4 36 40
The weeks are coloured automatically according to their week number.
You can see the part I am stuck on highlighted in bold
See code below:
Code:
Public Function WeekNumberFromDate(DT As Date, StartDate As Date) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' WeekNumberFromDate
' This returns the week number base on Week 1 starting on StartDate.
' =TRUNC(((DT-StartDate)+6)/7)+(WEEKDAY(DT)=WEEKDAY(StartDate))
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
WeekNumberFromDate = Int(((DT - StartDate) + 6) / 7) + Abs(Weekday(DT) = Weekday(StartDate))
End Function
Sub colour_me_elmo()
'Output the working days of month starting from the second working day in E24 to E48
'Colour the cell according to the week number 1-52 with the matching Excel built in colours 1-52
'Format dd/mm/yyyy
Dim StartDay, EndDay, ThisDay As Date
StartDay = Range("B69").Value
EndDay = Range("B70").Value
ThisDay = StartDay
Dim WeekCounter as Integer
Dim cellrange As Range
Set cellrange = ActiveSheet.Range("E24:E48")
Range("E24:E48").Clear
WeekCounter = 1
For Each cellrange In ActiveSheet.Range("E24:E48").Cells
'If we haven't reached the end of the range
'This means if we don't have enough days in the current
'month to fill each cell E24:E48, no dates will be output for the remainder of the range
If ThisDay <= EndDay Then
'Current date we're checking is Stored in ThisDay
'Calculate the day of the week of the current date in ThisDay
Lweekday = Weekday(ThisDay, vbSunday)
'Only output the date to the cell and colour the cell if the date is a weekday
If Lweekday <> 1 And Lweekday <> 7 Then
'Insert date value into Cell cellrange
cellrange.Value = ThisDay
'Colour the cell according to the week number 1-52 with the matching Excel built in colours 1-52
cellrange.Interior.ColorIndex = WeekNumberFromDate(ThisDay, "1/1/2013")
End If
'LweekDay 2=Monday 5=Friday so check if we're at the start or the end of the week
If LWeekday = 2 Then
'At start of week
'Put row value from cellrange in the coresponding cell in column B
'B& WeekRow(WeekCounter) = cellrange.Row
End If
If LWeekday = 5 Then
'Put row value from cellrange in the coresponding row in column C
'C& WeekRow(WeekCounter) = cellrange.Row
WeekCounter = WeekCounter + 1
End If
Lweekday = Weekday(ThisDay, vbSunday)
'If Day is Friday increment by three
If Lweekday = 6 Then
ThisDay = DateAdd("d", 3, ThisDay)
Else
'Increment the date by one date
ThisDay = DateAdd("d", 1, ThisDay)
End If
End If
Next cellrange
End Sub