Forum Discussion
NikolinoDE
Jul 08, 2020Gold Contributor
entering the working time, automatically marked with color in the timeline.
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? TEST Sheet Ps. My knowledge in Excel is...
- Jul 12, 2020
No 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!
Subodh_Tiwari_sktneer
Jul 09, 2020Silver Contributor
Your table is blank so it is hard to visualize what exactly you are trying to achieve here.
Why not enter some time values and mock up the desired output manually and upload the file again to show what you are trying to achieve?
- NikolinoDEJul 09, 2020Gold ContributorHi Subodh_Tiwari_sktneer,
sorry for my mistake, wrong file 😞
here is the right file 🙂
https://www.transfernow.net/mK46HT072020
Please download the file and my project is then self-explanatory 🙂
Thx in Advance for any help.
Nikolino- Subodh_Tiwari_sktneerJul 10, 2020Silver Contributor
I have placed the formulas in rows 7 and 8 and you will need to copy the same formula to other rows but change the range reference accordingly. Remember these are Array Formulas so you will need to confirm it with Ctrl+Shift+Enter not Enter only.
- NikolinoDEJul 10, 2020Gold ContributorHi Subodh Tiwari , thanks in advance for your help and effort.
Downloaded it, but it doesn't work. With MA1 line, the entire line turns yellow and not the specified time entry.
Maybe I'm doing something wrong, just don't know what ...
For MA1, only the time entry from 6:00 a.m. to 2:00 p.m. should be yellow, the rest of the row must not be colored. This should be with every MA, so that you can see the daily occupancy.
Supplementary question: could the problem be accomplished without an array formula?
Think that with Aray formulas the workbook will be very slow if you consider 12 months with 10 MA .... Don't know, it's just a question of a beginner like me.
This does not mean that I could not live with the proposed solution, on the contrary :-), would only work once.
Thanks again, i appreciate it knows how much time and patience it takes.
Nikolino