Hello, I'm new to this forum, had a bit of VBA experience ages ago, but since the original writer died due to a car crash, we've looked for someone else to take over and that would be me.
Now, for every day of the week, there is a sheet "maandag" = Monday, etc.
on that sheet, we fill in the C-column the hours they need to work eg. 09:00-22:00
Then after it pops a dialog asking if it's a split-shift and clicking "no", it colors the shift automatically in the roster, and updates it in the week-report.
Now, that last part need to change: all hrs before 16:30 should be in the "vroege" (early) columns, all after 16:30 must go in de "late" columns.
The Monday sheet:
https://drive.google.com/file/d/12HDDypLRKda5nIGalmxyW8Pt55M1LUL7/view?usp=sharing
The code on the monday sheet:
The week-report:
https://drive.google.com/file/d/1MkgJ6-w692FHs09aBjevLQ_JWluIeiRJ/view?usp=sharing
The function that "aantaluren" calls:
As you can see I've been messing around with dividing with select.texttocolumns and then =timevalue(CH5), the point was that if the value was < 0,6875 (what is 16:30) then column c, else ... but that's a wrong way to get where i want :s
Thanks in advance for the help on cracking this prob :wink:
Xurm
Now, for every day of the week, there is a sheet "maandag" = Monday, etc.
on that sheet, we fill in the C-column the hours they need to work eg. 09:00-22:00
Then after it pops a dialog asking if it's a split-shift and clicking "no", it colors the shift automatically in the roster, and updates it in the week-report.
Now, that last part need to change: all hrs before 16:30 should be in the "vroege" (early) columns, all after 16:30 must go in de "late" columns.
The Monday sheet:
https://drive.google.com/file/d/12HDDypLRKda5nIGalmxyW8Pt55M1LUL7/view?usp=sharing
The code on the monday sheet:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim waarde As String
Dim split As Variant
Dim dag As Date
Dim i As Integer
i = 1
If Not Intersect(Target, Target.Worksheet.Range("C4:C40")) Is Nothing Then
If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then
Exit Sub
End If
On Error Resume Next
waarde = Target.Value
split = MsgBox("Is het een splitshift?", vbYesNo + vbQuestion)
KleurVelden waarde, Target.Row, Target.Column, split
End If
End Sub
The week-report:
https://drive.google.com/file/d/1MkgJ6-w692FHs09aBjevLQ_JWluIeiRJ/view?usp=sharing
The function that "aantaluren" calls:
Code:
Function AantalUren(naam As String, dag As String) As Double
Dim ws As Worksheet
Set ws = Sheets(dag)
Dim sum As Double
Dim i As Integer
sum = 0
For i = 1 To 38
If ws.Cells(i, "A").Value = naam Then
For Each c In ws.Range("A" & i, "CC" & i)
If c.Interior.ColorIndex = 16 Or c.Interior.ColorIndex = 15 Then
sum = sum + 1
End If
Next
End If
Next
sum = sum / 4
If (sum > 4.5) Then
sum = sum - 0.5
End If
AantalUren = sum
End Function
As you can see I've been messing around with dividing with select.texttocolumns and then =timevalue(CH5), the point was that if the value was < 0,6875 (what is 16:30) then column c, else ... but that's a wrong way to get where i want :s
Thanks in advance for the help on cracking this prob :wink:
Xurm