Solved: Hours to be worked by Month

[marshybid]

Hi All,

I have a large amount of data that I filter through each week.

I would like to create a seperate report from this data which will do the following;

Each row of data will contain a start date (column F) and an end date (column G), however each contractor may appear in multiple rows, this could be deternmined by status however I would only want to report on status active.

Based on the start date and end date I would like a table to be created for each year that the contract covers on a seperate sheet (new sheet for each year) that shows one instance of each contractor name (Column A) then Columns B - M to show Jan - Dec and the hours anticipated to be populated for each month the contractor is working in each year based on 7.5 hours per day (5 day working week).

So if a contractor has a 12 month contract from today the 2008 table would show January to May (no values) June to December anticipated hours, then the 2009 Table would show January to June 2009 anticipated hours

I hope this all makes some sort of sense

Thanks,

Marshybid

I have attached an example spreadsheet, the actual data contains c. 10,000 rows of data

[Bob Phillips]

An example of the results would be useful. I think I get it but oit would be clearer.

[marshybid]

An example of the results would be useful. I think I get it but oit would be clearer.

Morning xld,

I have amended the attachment for you.

The first contracor (highlighted in green) shows expected results for 2008 and 2009.

Hope this helps.

Thanks,

Marshybid

[Bob Phillips]

All done with formulae

[marshybid]

All done with formulae
Thanks xld,

So I can just get my macro for the main data sheet to create a worksheet for each year (2008, 2009, 2010, etc) then as part of the macro populate the formulas into the appropriate cells on each sheet?

Once again, you make it all look way too easy.

Marking as solved.

Marshybid :hi:

[Bob Phillips]

Give a mouse a cookie ...



Public Sub DoTheStuff()
Dim sh As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim StartYear As Long
Dim EndYear As Long
Dim i As Long, j As Long
Const DaysFormula = _
"=IF(OR($A2="""",Sheet1!$F2>DATE($N$1,COLUMN(),0),Sheet1!$G2<DATE($N$1,COLUMN()-1,1)),""""," & _
" N(NETWORKDAYS(MAX(Sheet1!$F2,DATE($N$1,COLUMN()-1,1),DATE($N$1,1,1)),MIN(Sheet1!$G2,DATE($N$1,COLUMN(),0),DATE($N$1,12,31)) ))*7.5)"

With Application

.DisplayAlerts = False
.ScreenUpdating = False
End With

With ActiveSheet

Set rng = .UsedRange
LastRow = rng(rng.Count).Row
StartYear = .Evaluate("MIN(YEAR(F2:G" & LastRow & "))")
EndYear = .Evaluate("MAX(YEAR(F2:G" & LastRow & "))")
For i = StartYear To EndYear

On Error Resume Next
Worksheets(CStr(i)).Delete
On Error GoTo 0
Set sh = Worksheets.Add(after:=.Parent.Worksheets(.Parent.Worksheets.Count))
sh.Name = i
.Columns(1).Copy sh.Range("A1")
For j = 1 To 12

sh.Cells(1, j + 1).Value = Format(DateSerial(Year(Date), j, 1), "mmm")
Next j
sh.Range("B1").Resize(, 12).Font.Bold = True
sh.Range("B1").Resize(, 12).Interior.ColorIndex = 6
sh.Range("B1").Resize(, 12).HorizontalAlignment = xlHAlignCenter
sh.Range("N1").Value = i
sh.Range("B2").Resize(LastRow - 1, 12).Formula = DaysFormula
Next i
End With
With Application

.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

[marshybid]

Give a mouse a cookie ...



Public Sub DoTheStuff()
Dim sh As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim StartYear As Long
Dim EndYear As Long
Dim i As Long, j As Long
Const DaysFormula = _
"=IF(OR($A2="""",Sheet1!$F2>DATE($N$1,COLUMN(),0),Sheet1!$G2<DATE($N$1,COLUMN()-1,1)),""""," & _
" N(NETWORKDAYS(MAX(Sheet1!$F2,DATE($N$1,COLUMN()-1,1),DATE($N$1,1,1)),MIN(Sheet1!$G2,DATE($N$1,COLUMN(),0),DATE($N$1,12,31)) ))*7.5)"

With Application

.DisplayAlerts = False
.ScreenUpdating = False
End With

With ActiveSheet

Set rng = .UsedRange
LastRow = rng(rng.Count).Row
StartYear = .Evaluate("MIN(YEAR(F2:G" & LastRow & "))")
EndYear = .Evaluate("MAX(YEAR(F2:G" & LastRow & "))")
For i = StartYear To EndYear

On Error Resume Next
Worksheets(CStr(i)).Delete
On Error GoTo 0
Set sh = Worksheets.Add(after:=.Parent.Worksheets(.Parent.Worksheets.Count))
sh.Name = i
.Columns(1).Copy sh.Range("A1")
For j = 1 To 12

sh.Cells(1, j + 1).Value = Format(DateSerial(Year(Date), j, 1), "mmm")
Next j
sh.Range("B1").Resize(, 12).Font.Bold = True
sh.Range("B1").Resize(, 12).Interior.ColorIndex = 6
sh.Range("B1").Resize(, 12).HorizontalAlignment = xlHAlignCenter
sh.Range("N1").Value = i
sh.Range("B2").Resize(LastRow - 1, 12).Formula = DaysFormula
Next i
End With
With Application

.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub


Hi xld, Thanks for the code above.

However, I get a compile Error (Wrong number of arguments or invalid property assignment) on this line of code


sh.Cells(1, j + 1).Value = format(DateSerial(Year(Date), j, 1), "mmm")

the whole code that I am using is below



Sub ContStaff()

range("AK1").Select
ActiveCell.FormulaR1C1 = "Legal Entity"
range("AK2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RIGHT(RC[-9],1)="")"",MID(RC[-9],LEN(RC[-9])-9,6),LEFT(RC[-9],6))"
range("AK2").Select
ActiveCell.Offset(0, -1).range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
range("AL1").Select
ActiveCell.FormulaR1C1 = "CCentre"
range("AL2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RIGHT(RC[-10],1)="")"",LEFT(RC[-10],5),RIGHT(RC[-10],5))"
range("AL2").Select
ActiveCell.Offset(0, -1).range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
range("A1:AL1").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.Bold = True
Selection.AutoFilter
range("A1").Select

Call DoTheStuff

End Sub
Public Sub DoTheStuff()
Dim sh As Worksheet
Dim rng As range
Dim LastRow As Long
Dim StartYear As Long
Dim EndYear As Long
Dim i As Long, j As Long
Const DaysFormula = _
"=IF(OR($A2="""",Sheet1!$F2>DATE($N$1,COLUMN(),0),Sheet1!$G2<DATE($N$1,COLUMN()-1,1)),""""," & _
" N(NETWORKDAYS(MAX(Sheet1!$F2,DATE($N$1,COLUMN()-1,1),DATE($N$1,1,1)),MIN(Sheet1!$G2,DATE($N$1,COLUMN(),0),DATE($N$1,12,31)) ))*7.5)"

With Application

.DisplayAlerts = False
.ScreenUpdating = False
End With

With ActiveSheet

Set rng = .UsedRange
LastRow = rng(rng.Count).Row
StartYear = .Evaluate("MIN(YEAR(F2:G" & LastRow & "))")
EndYear = .Evaluate("MAX(YEAR(F2:G" & LastRow & "))")
For i = StartYear To EndYear

On Error Resume Next
Worksheets(CStr(i)).Delete
On Error GoTo 0
Set sh = Worksheets.Add(after:=.Parent.Worksheets(.Parent.Worksheets.Count))
sh.Name = i
.Columns(1).Copy sh.range("A1")
For j = 1 To 12

sh.Cells(1, j + 1).Value = format(DateSerial(Year(Date), j, 1), "mmm")
Next j
sh.range("B1").Resize(, 12).Font.Bold = True
sh.range("B1").Resize(, 12).Interior.ColorIndex = 6
sh.range("B1").Resize(, 12).HorizontalAlignment = xlHAlignCenter
sh.range("N1").Value = i
sh.range("B2").Resize(LastRow - 1, 12).Formula = DaysFormula
Next i
End With
With Application

.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub


Hoping you can help

Thanks,

Marshybid :dunno

[Bob Phillips]

It is because yout UsedRange extends beyond the data. Try this instead. BTW, I would call DoTheStuff before the other code., not after




Public Sub DoTheStuff()
Dim sh As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim StartYear As Long
Dim EndYear As Long
Dim i As Long, j As Long
Const DaysFormula = _
"=IF(OR($A2="""",Sheet1!$F2>DATE($N$1,COLUMN(),0),Sheet1!$G2<DATE($N$1,COLUMN()-1,1)),""""," & _
" N(NETWORKDAYS(MAX(Sheet1!$F2,DATE($N$1,COLUMN()-1,1),DATE($N$1,1,1)),MIN(Sheet1!$G2,DATE($N$1,COLUMN(),0),DATE($N$1,12,31)) ))*7.5)"

With Application

.DisplayAlerts = False
.ScreenUpdating = False
End With

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
StartYear = .Evaluate("MIN(YEAR(F2:G" & LastRow & "))")
EndYear = .Evaluate("MAX(YEAR(F2:G" & LastRow & "))")
For i = StartYear To EndYear

On Error Resume Next
Worksheets(CStr(i)).Delete
On Error GoTo 0
Set sh = Worksheets.Add(after:=.Parent.Worksheets(.Parent.Worksheets.Count))
sh.Name = i
.Columns(1).Copy sh.Range("A1")
For j = 1 To 12

sh.Cells(1, j + 1).Value = Format(DateSerial(Year(Date), j, 1), "mmm")
Next j
sh.Range("B1").Resize(, 12).Font.Bold = True
sh.Range("B1").Resize(, 12).Interior.ColorIndex = 6
sh.Range("B1").Resize(, 12).HorizontalAlignment = xlHAlignCenter
sh.Range("N1").Value = i
sh.Range("B2").Resize(LastRow - 1, 12).Formula = DaysFormula
Next i
End With
With Application

.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

[marshybid]

Hi xld,

Replaced the code with your revised version and placed Call DoTheStuff at the top of my macro (see below) Still get the same error message.

I'll replave the example spreadsheet with a complete sheet.



Sub ContStaff()
Call DoTheStuff
range("AK1").Select
ActiveCell.FormulaR1C1 = "Legal Entity"
range("AK2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RIGHT(RC[-9],1)="")"",MID(RC[-9],LEN(RC[-9])-9,6),LEFT(RC[-9],6))"
range("AK2").Select
ActiveCell.Offset(0, -1).range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
range("AL1").Select
ActiveCell.FormulaR1C1 = "CCentre"
range("AL2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RIGHT(RC[-10],1)="")"",LEFT(RC[-10],5),RIGHT(RC[-10],5))"
range("AL2").Select
ActiveCell.Offset(0, -1).range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
range("A1:AL1").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.Bold = True
Selection.AutoFilter
range("A1").Select



End Sub
Public Sub DoTheStuff()
Dim sh As Worksheet
Dim rng As range
Dim LastRow As Long
Dim StartYear As Long
Dim EndYear As Long
Dim i As Long, j As Long
Const DaysFormula = _
"=IF(OR($A2="""",Sheet1!$F2>DATE($N$1,COLUMN(),0),Sheet1!$G2<DATE($N$1,COLUMN()-1,1)),""""," & _
" N(NETWORKDAYS(MAX(Sheet1!$F2,DATE($N$1,COLUMN()-1,1),DATE($N$1,1,1)),MIN(Sheet1!$G2,DATE($N$1,COLUMN(),0),DATE($N$1,12,31)) ))*7.5)"

With Application

.DisplayAlerts = False
.ScreenUpdating = False
End With

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
StartYear = .Evaluate("MIN(YEAR(F2:G" & LastRow & "))")
EndYear = .Evaluate("MAX(YEAR(F2:G" & LastRow & "))")
For i = StartYear To EndYear

On Error Resume Next
Worksheets(CStr(i)).Delete
On Error GoTo 0
Set sh = Worksheets.Add(after:=.Parent.Worksheets(.Parent.Worksheets.Count))
sh.Name = i
.Columns(1).Copy sh.range("A1")
For j = 1 To 12

sh.Cells(1, j + 1).Value = format(DateSerial(Year(Date), j, 1), "mmm")
Next j
sh.range("B1").Resize(, 12).Font.Bold = True
sh.range("B1").Resize(, 12).Interior.ColorIndex = 6
sh.range("B1").Resize(, 12).HorizontalAlignment = xlHAlignCenter
sh.range("N1").Value = i
sh.range("B2").Resize(LastRow - 1, 12).Formula = DaysFormula
Next i
End With
With Application

.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub


Thanks

Marshybid

[Bob Phillips]

Try this

[marshybid]

Try this
Hi xld,

Can't understand it.

I just keep getting the same error message;

Compile Error (Wrong number of arguments or invalid property assignment)

it appears at this line;

sh.Cells(1, j + 1).Value = format(DateSerial(Year(Date), j, 1), "mmm")

and highlights the word format????

I'm really confused with this one. Firstly I don't really understand what the error message is trying to tell me!!

Marshybid

[Bob Phillips]

I think you have a function called format somewhere.

Select the word Format, and hit Shift-F2, and see what it does.

Other than that, go to Tools>References, and see if there are any items marked MISSING.

[marshybid]

I think you have a function called format somewhere.

Select the word Format, and hit Shift-F2, and see what it does.

Other than that, go to Tools>References, and see if there are any items marked MISSING.
:bow: :bow: :bow: :bow: :bow:
How on earth did you work that out!!!!!!!!

Hit shift F2 and there it was.... a function called format from a really old piece of code.

Duly deleted.. The code now works exactly as you originally predicted.

Apologies for all the toing and froing.

Thanks so much for the help.

Marshybid:hi:

[Bob Phillips]

The fact that it had a lower-case f was what made me think of that.

[jammer6_9]

xld is Distinguished Lord of VBAX so don't wonder why :whistle: