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!
NikolinoDE
Jul 09, 2020Gold Contributor
Hi 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
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_sktneer
Jul 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- NikolinoDEJul 10, 2020Gold Contributor
Hi Subodh Tiwari ,
Send the file with the details again. Believe that a picture can say a thousand words ... it is the same with an excel sheet.
Think so you can better imagine what I want to do. It is about services, 1,2,3 that should appear in a timeline ... only the time that each MA has done every day in the month. All other fields in the timeline should remain white.
Sorry in advance that I will take your time, but as a beginner (I see myself) I need "a little" help.Nikolino
- Subodh_Tiwari_sktneerJul 11, 2020Silver Contributor
Since I cannot open your file I am unable to see what you were trying to show in this file. Can you open the file you uploaded in your last post?
But please find the attached in which I have applied a conditional formatting. I selected the range C7:AX7 and applied a New Rule for conditional formatting to color the cells where formula returns time values, so that other cells without any time value in the timeline have no color in them.
Refer to the attached for more details.