Forum Discussion
entering the working time, automatically marked with color in the timeline.
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 SubAlso, 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!
Hi,
Sry ... try to show what I want to do because my english is not the best.
I have used VBA to get what you are trying to achieve.
You just need to enter the time in columns with from and to headers and timeline should be highlighted as per the time entered.
The code will only work if you enter the from time first and then enter the to time so you will have to take care of that.
You will also find a button called Clear Timeline placed in cell A3 which you can click to clear the timeline.
This approach uses no formulas, the time values will be placed by the code on the timeline.
This has consumed good amount of time so this is the max I can do for you.
- Thanks for the hint.
I would like to apologize if I should have said something sloppy ... that was not my intention. Apologize for my persistence on this topic ... based on my very little VBA knowledge and at the same time, to be honest, I took a bit over and promised my colleagues to do it for our team.
It is not my job to construct excels ... I don't earn my living with it,
I only do it because I enjoy it and I like to learn something ... at the same time a little show with my colleagues :-).
Anyway thanks for the effort and patience you had with me ... wish you all the luck in the world, with love, joy and health.
Nikolino 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.
- Hi Hi Subodh Tiwari sktneer,
It doesn't work like before.
The working hours contributions of MA 1 in January should be shown in sheet IND1 in cell row F13: BA13, but can be seen in F9: BA9. And only the first two services can be seen ("Dienst 1" and "Dienst 2", "Bereitschaft" is missing in IND1).
Funny in the previous version of you, the colors in the fields in worksheet IND1 appeared automatically.
In worksheet IND1, the MA (colleagues) of G1: P1, in Q is only the sum of the team.
If I enter times in the January worksheet at MA1 (in Dienst 1, 2 and Bereitschaft), for example on January 1, worksheet IND1 should appear in color 13 in F13: BA13.
Where i make the mistake?
Maybe I'm not doing something right there...maybe or sure..if I didn't cry I would laugh 🙂
Thx
Nikolino 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.
- If you enter a time on January Sheet in any cell and if you find that the time you entered is not populated by the code on IND1 Sheet, manually overwrite that time on IND1 Sheet in Row#8. e.g. if you enter a time say 2:30 in any cell on January sheet and if this time is not populated by the code on IND1 Sheet for the corresponding date and employee, locate that time in Row#8 on IND1 Sheet, in this case it would be 2:30 so find the cell with the time 2:30 in Row#8 on IND1 Sheet and select that cell and type 2:30 to overwrite the preexisting time in that cell. Now come back to the January Sheet, select the cell where you previously entered the time 2:30, press F2 key to go into the edit mode and hit Enter and this will trigger the code again and see if this time is now populated by the code on IND1 Sheet. Please remember, the time you enter on January Sheet must match with time on IND1 Sheet in Row#8.
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 🙂
ThxNikolino
- Bow me !!!
Great ... awesome
Thanks alot
I know it was a difficult birth with me ... but as far as I can see ... IT WORKS ... I will continue tomorrow .... thanks again and wish you love, joy and health in your life.
Regards,
Nikolino 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 SubAlso, 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!
- Since I am a bloody beginner in VBA, is it possible that you send me the file with the code so that I can simply copy it for the next few months?
I know that I ask a lot, but as a beginner and self-learner, I have no other way of getting close to a solution.
Wish life gives you much more back 🙂
Nikolino 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...
- Open the VB Editor by pressing Alt+F11.
- On Project explorer on the left side of the editor, double click the January Sheet and the January Sheet module will be opened with the code on it.
- Copy the whole code from the code window.
- Now double click the next month Sheet on the project explorer which will open a blank code window, just paste the copied code into the opened code window.
- Now the next month sheet will have the same functionality.
- Remember to have the same layout with the next month's sheet similar to the January Sheet layout.
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.
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! 🙂Is that possible? for the whole month? ... and so that I can copy it for the next month?
Really great ... thanks 🙂Please watch this short video demo to know how does this work. Is this not what you trying to achieve?
- Either what is likely I am doing something wrong or it is not working. At least not as I imagined.
Enter time in sheet January (Duty 1, 2 or 3) and automatically appear in timeline in sheet IND1. Without buttons or additional buttons. It seems it is not possible with VBA, maybe with formulas?
Will probably have to keep looking to find a solution.
Thanks again for your time and effort ... even if it didn't work ... at least one like was earned by me 🙂
Thx again 🙂 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?
- it doesn't work that way either ... only shows the first time (10:00 to 15:00) and then nothing. With three Duties entries in the same day, it only shows the start time and end time of the three duties without color.
Here is the updated file. You can see all the 3 duties are highlighted in Row#10 on IND1 Sheet for the employee JeWo.
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.
- Colleague JeWo
Sheet "January" working time entry in: I10: J10 and L10: M10 and O10: P10.
Should all automatically appear as a timeline in "IND1" from F10 to BA10.
But do not appear.
Should have a timeline from 10:00 to 15:00 in sheet IND1 (which is also) and a second timeline (color) from 17:00 to 21:00 as well as from 22:00 to 00:00 (= 24:00 ) have an additional timeline.
Only have a timeline from 10:00 a.m. to 3:00 p.m. in the workbook you sent, the other times cannot be seen in IND1.
Am I doing something wrong or thinking wrong?
As I said ... have been attached to this task for some time and just can't get any further ... if possible you could show me the way for a colleague.
Thank you again ... hope not annoy you with so much thank you 🙂 It is exactly doing what you described.
Look at the file I am attaching here.
The January Sheet has time values in I10:J10 and I24:J24 and now look at the IND1 Sheet, do you see the timeline highlighted in Row#10 and 164 for the employee JeWo?
Also, the timeline is highlighted with the color of employee JeWo set in the cell I1 on IND1 Sheet.
Isn't it what you are trying to achieve?
I have the feeling I'm too stupid to explain it correctly.
From sheet Januar, the times entered in sheet IND1 (as I sent it in the workbook) would like to be automatically displayed as a timeline in color ... the working time I entered in Januar ... not in IND1. Timeline is in IND1 From F to BA. Workingtime is in January from to and Duty 1,2 & 3.Enter Time in Januar as a examble from 10:00 to 18:00 the corresponding timeline should appear in IND1 sheet with colour from 10:00 to 18:00.
I tried the file sent to me and does not work as it should ... if you could do something with what I could explain to you, it would be a great help ... if not, don't worry ... don't want to be a burden.
I can't get any further ... and at the same time I take up your time and your nerves too much.
Thank you anyway for everythingNikolino
Please find the attached with the tweaked code.
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.
You will also find a button called "Clear the Selected Timeline Cells" on IND1 Sheet.
You may use this button to clear the timeline if required and to do so, just select the cells on the timeline you want to remove the color from and click this button to clear the color from the selected cells on the timeline.
- hope i have solved it now ... once again for the circumstances. If it doesn't work now 😞 i dont know any solution after that...
https://www.transfernow.net/WFZIs7072020
put it online for download in another page I am really sorry. Still unable to open any of your files, same issue.
I downloaded the workbook from me first and then opened it. At the beginning it showed that it had a problem with Inquire. but after switching off the Inquire it works without problems. Send it again for security, no add-in inquire.
I apologize again for the circumstances I am making. But the file is a bit strange ... it works in my PC and when I load it into the forum it doesn't work afterwards .... maybe because it is an .xlsm file ... don't know.
But now I hope to have charged it correctly, with me it opens without problems ... slowly but it opens.As I said, I want the Working times that I enter in sheet "Januar" should appear yellow in sheet "IND1" ... in the correct place and date. It should only show the working hours in color ... only the working hours.
Examble: all fields from 10:00 to 17:00 must appear with color (the same color that the MA also has). All other cells should be without color in the same row. Other examble:
The colleague (MA1) has duty 1 from 10:00 a.m. to 2:00 p.m. and duty 2 from 4:00 p.m. to 6:00 p.m. All cells from 10:00 to 14:00 should be colored and all cells from 16:00 to 18:00 should be colored. In between as well as therefor and afterwards all cells should be in the same row without color.As I said my English is not the best ... let my VBA 🙂 ... I appreciate your help ... just have to help me get a result:-).ThxNikolinoI cannot open your file. Can you open the file which you uploaded in your last post?