Jul 08 2020 01:08 PM
When entering the working time in a time entry, this time should be automatically marked with color in the timeline.
Is this possible?
if yes... how?
Any help is welcome
Thx in Advance
Nikolino
Jul 12 2020 09:11 AM - edited Jul 12 2020 09:11 AM
This is all being done with the help of Sheet Change Event i.e. the code underneath gets triggered automatically once you change the cell content on January Sheet.
So you will need to reenter the existing time again so that the change event code triggers and highlight the timeline.
OR test the code by entering some new time values on January Sheet and let me know if the timeline is being highlighted correctly as per the time entered in January Sheet.
Jul 12 2020 09:28 AM
Here is the updated file. You can see all the 3 duties are highlighted in Row#10 on IND1 Sheet for the employee JeWo.
Jul 12 2020 09:34 AM
Jul 12 2020 09:56 AM
Did you test the updated file I uploaded in my last post?
As I said, this feature relies on Sheet Change Event so if you don't see a timeline highlighted for time you see on January Sheet, all you need to do is, select the time cell on January Sheet, press F2 key and hit Enter, this will trigger the Change Event code and it will correctly highlight the timeline. Does that make sense?
Jul 12 2020 10:41 AM
Jul 12 2020 11:36 AM
Please watch this short video demo to know how does this work. Is this not what you trying to achieve?
Jul 12 2020 11:56 AM
WOW great with video !!!
It is EXACTLY what I want to do
Simply enter the time in Sheet Januar and have it shown in sheet IDN1, for each colleague and each day individually ... EXACTLY THIS! :)
Jul 12 2020 01:12 PM
You're welcome!
Great! Glad it is working as desired in the end.
After inserting the next month's sheet, you need to copy the code from January Sheet Module and place it on the next month's Sheet module.
To do this follow these steps...
Also, this code will work for all the employees and for all the dates provided you pay attention to some notes I posted in one of my posts, posting them again for your reference and make sure you follow them exactly as described.
**********************************************************************************************
Please note that in order to make this code work properly, you will have to input "from" and "to" column headers for all the columns for all the employees in Row#9 on January Sheet i.e. if you enter a time in any cell and if the header for that column in Row#9 is not either from or to, the code will not work properly.
Also note that when you enter the from time for any employee, enter to time for that employee first before entering from time for another employee otherwise this code will not work.
I have also changed the employee name sequence in column E on IND1 Sheet as per the sequence of the employees entered in the range H1:Q1 on IND1 Sheet.
The timeline will be highlighted as per the color of the employee in the range H1;Q1 so you may change the color for a employee if you wish.
If in any case the timeline is not highlighted for some time values you enter on January Sheet, make sure to enter the same time in Row#8 on IND1 Sheet and reenter time on January Sheet again to highlight the timeline on IND1 Sheet.
**********************************************************************************************
Please take a minute to accept the post with the proposed solution as a Best Response in order to mark your question as Solved.
Please refer to the following screenshot to know where to find Sheets on Project Explorer on the VB Editor.
Jul 12 2020 01:36 PM
Jul 12 2020 01:56 PM
SolutionNo problem. Here is the code you need to place on Next month's Sheet module.
Public sTimeFound As Boolean
Public sColumn As Long
Public eColumn As Long
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim timeType As String
Dim dt As Date
Dim empRow As Long
Dim startCell As Range
Dim timeRng As Range
Dim dtCel As Range
Dim tCel As Range
Dim dtRng As Range
Dim emp As String
Dim n As Variant
Dim dws As Worksheet
Dim empRng As Range
Dim inputRng As Range
Dim clr As Long
Set dws = Worksheets("IND1")
Set empRng = dws.Range("H1:Q1")
Set dtRng = dws.Range("C8:C348")
Set timeRng = dws.Range("F8:BA8")
Set inputRng = Range("I10:EZ40")
Application.EnableEvents = False
If Not Intersect(Target, inputRng) Is Nothing Then
timeType = VBA.Trim(Cells(9, Target.Column).Value)
emp = Cells(5, Target.Column).MergeArea.Cells(1).Value
n = Application.Match(emp, empRng, 0)
clr = empRng.Cells(n).Interior.Color
If IsError(n) Then
MsgBox "The employee " & emp & " doesn't exist on " & dws.Name & " Sheet.", vbExclamation
GoTo Skip
End If
If (LCase(timeType) = "from" Or LCase(timeType) = "to") And Target <> "" Then
dt = Cells(Target.Row, 2).Value
For Each dtCel In dtRng
If dtCel.Value = dt Then
empRow = dtCel.Row
empRow = empRow + n
Exit For
End If
Next dtCel
For Each tCel In timeRng
If CDate(tCel.Value) = CDate(Target.Value) And LCase(timeType) = "from" Then
sColumn = tCel.Column
With dws.Cells(empRow, sColumn)
.Value = Target.Value
.NumberFormat = "hh:mm"
End With
sTimeFound = True
Exit For
ElseIf CDate(tCel.Value) = CDate(Target.Value) And LCase(timeType) = "to" Then
eColumn = tCel.Column
With dws.Cells(empRow, eColumn)
.Value = Target.Value
.NumberFormat = "hh:mm"
End With
End If
Next tCel
End If
If sColumn <> 0 And eColumn <> 0 And sTimeFound = True Then
If Application.Count(dws.Range("F" & empRow, dws.Cells(empRow, sColumn - 1))) = 0 Then
dws.Range("F" & empRow, dws.Cells(empRow, sColumn - 1)).Interior.ColorIndex = xlNone
ElseIf Application.Count(dws.Range(dws.Cells(empRow, eColumn + 1), "BA" & empRow)) = 0 Then
dws.Range(dws.Cells(empRow, eColumn + 1), "BA" & empRow).Interior.ColorIndex = xlNone
End If
dws.Range(dws.Cells(empRow, sColumn), dws.Cells(empRow, eColumn)).Interior.Color = clr
sColumn = 0
eColumn = 0
sTimeFound = False
End If
End If
Skip:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Unprotect "1234"
With Range("A10:EZ40").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.PatternTintAndShade = 1
End With
If Not Intersect(Target, Range("A10:EZ40")) Is Nothing Then
With Range(Cells(Target.Row, 1), Cells(Target.Row, 156)).Interior
.Pattern = xlGray25
.PatternThemeColor = xlThemeColorAccent2
.PatternTintAndShade = 0.399945066682943
End With
Application.EnableEvents = False
Target.Activate
Application.EnableEvents = True
End If
Protect "1234"
End Sub
Also, don't forget to mark the post with the proposed solution as a Best Response. :)
Thanks for all your wishes.
Have a good time ahead!
Jul 12 2020 02:03 PM
Jul 13 2020 08:38 AM
I still need one last help. I translated everything in German on the sheet and also changed the VBA code into the words.
Have it installed so as mandatory, but I come to no result.
Sure there is a mistake somewhere ... as sure is that I can't find it ... even if I could have made it accidentally.
Sending you file and ask for one last time for help and patience with me :)
Nikolino
Jul 13 2020 01:21 PM
Please find the attached with the tweaked codes.
Points to remember.
The employees names in Row#5&6 on January Sheet must exactly match with the employees names in the range G1:Q1 on IND1 Sheets.
I have tweaked the formulas on January Sheet in Row#5&6 for you.
Jul 13 2020 01:57 PM
Jul 13 2020 11:33 PM
This is not fair as you don't want to pay attention to any of my post.
I have clearly mentioned several times that under which condition this code would not work but probably you didn't read my instruction and notes carefully.
It is you who has to manage and control this file in future not me so it is important for you to know what should be the correct layout of the month sheet and IND1 sheets to make this code work perfectly.
Do one thing, go through all my previous posts and read all my points and instructions and make the correction accordingly in your file as you need to learn yourself to debug the issues in future.
I would give you a hint though and it is the sequence of the employee in column E on IND1 Sheet which doesn't match with the sequence of employees in the range G1:Q1.
Correct this sequence and then test the code again.
Jul 13 2020 11:45 PM