PDA

View Full Version : [SOLVED] Time Chart from Data



Rishek
05-29-2017, 11:48 AM
So I have been slowly but surely building a process to automate a cross check procedure using macros supplied by various people on this board. This is a continuation of that.

19321

This is my ideal finished product. I have extracted all of the values in columns A through D on Sheet1 from a word document and then used a macro to get the values in E through H (G is a subtotal function and H checks to see if any of the times conflict for a given subtotal group).

What I'm looking to do is to present the data as they appear in Sheet2 and Sheet3. Row A should always appear as is, justified left on both sheets (it's a list of time in 15 minute increments from 9am to 10pm in the form hh:mm AM / PM).

The names in Column A would be drawn from Sheet 1 (each name only once). Then start and end times would populate the table, the Start and End times (column E and F from sheet 1) fitting into the cell of the nearest column they are larger than.

After that it would be a matter of filling the cells in rows between each start and end time with the name of the event and then conditionally highlighting them based on said name. I have four different types of events on here, but may end up with up to ten.

Feel free to tell me I'm dreaming on this one, it seems like quite a job.

mdmackillop
05-29-2017, 12:06 PM
Seems quite do-able. A couple of questions
Do you need a date column which will apply the results to different sheets?
Is Location relevant to your results?
Why Sheet 2 & Sheet 3? What is the difference?

Rishek
05-29-2017, 12:28 PM
Sheet 2 presents each person's time commitments on a given day. Sheet 3 shows which locations have been booked and when on the same day. I don't need a date column as far as I know. The cross check is performed daily and only relates to a specific days schedule.

These sheets are so I can get a quick overview of when a given person or location is free so that I can plug in more events on the fly, particularly when I'm away from my computer with a printout, e.g. "I need to see so-and-so tomorrow for 45 minutes. When and where can we do this?"

mdmackillop
05-29-2017, 02:08 PM
Give this a try.
Note that End times will appear in the "preceding" cell to allow the next booking to show as a follow on item. Formatting is picked up from the grid in column I rather than conditional formatting with 10 + conditions.

Rishek
05-29-2017, 03:39 PM
So I got this up and running after a few tries. Using some more representative mock data, I ended up with the following:

19325

Two questions:

Pulling the formatting from column I is actually quite good. It means I don't have to go recode things if I decide I want another color or add a new abbreviation. Could this table perhaps be pulled from another excel file?

The data set is created by applying a different macro to a word document, so right now I have to manually create the formatting column every time.

The locations (Schedule2) went a bit haywire, but I think it might be a better solution to run the original word document through a variant of my original extraction macro to end up with a list of locations and then run your Schedule1 macro again. And I ended up having to manually delete the new worksheets if I reran the macro (I think your DelSheets function was designed to get around this, not sure).

Thanks a lot! This looks really super.

mdmackillop
05-29-2017, 04:38 PM
We can hard code the colours. The sub will give you the colour from a cell. The Function replaces that in the code above.

There was an error in the 7pm times appearing in the 6.45 timeslots due I would guess to rounding errors. This has been corrected.

Clicking the button will delete the newly created sheets using the DelSheets code as part of the process.


Sub Colours()
For Each cel In Selection
cel.Offset(, 1) = cel.Interior.Color
Next
End Sub


Function Col(data As String)
Select Case data
Case "POR"
Col = 65535
Case "SIE"
Col = 5287936
Case "XER"
Col = 15773696
Case "OKL"
Col = 255
End Select


End Function

mdmackillop
05-29-2017, 04:55 PM
Here is the code applied to Mockup

Rishek
05-29-2017, 06:28 PM
Good to know with the color coding. Is there anywhere to get a list of these basic color codes? Google took me down a very deep, very hex RGB rabbit hole.

I'm encountering a problem that may have something to do with my implementation, I'm not sure. Essentially, although each color band is appearing next to only one name, all instances of the name are being transferred to my original sheet.

Have a look: 19328

Again, thanks for tackling this so far. I still have a few building blocks (http://www.vbaexpress.com/forum/showthread.php?59600-Extract-most-recent-quot-Header-quot-into-table) left to put in this workflow and then it needs optimizing, but it's getting there.

mdmackillop
05-30-2017, 03:17 AM
You can use your inbuilt ColorIndex which is simpler
Run this to see your available colours and change the Col function to suit.

Sub Colours()
Dim i as Long
For i = 1 To 56
Cells(i, 1).Interior.ColorIndex = i
Cells(i, 2) = i
Next
End Sub



Change this line (twice) to implement in the code

Cells(c.Row, S).Resize(, E - S + 1).Interior.ColorIndex = Col(Evnt)

With regard to duplicates not being removed, what version of Excel are you running? I'm using a a standard command (Data/Remove Duplicates)to do this but if it's not available on your PC we can look at another solution.

Rishek
05-30-2017, 05:55 AM
Really obvious point I have overlooked: at work I'm on a PC, at home I'm testing on a mac. For this and you other code, thanks. I'll test it when I get in today. This is looking very nearly there. Thank you!

mdmackillop
05-30-2017, 12:16 PM
Given the changed events, can I suggest you add a sheet to the template to contain Formats and Abbreviations which would be applicable to the Schedule sheets. The template would need to be kept up to date but may be a simpler solution.

mdmackillop
05-30-2017, 01:59 PM
Try this version
Unzip both files to the same folder and click the command button.
The Excel file which opens should show 1 entry which requires an end time. Rows which contain a time in column B for a day other than the Schedule day have been deleted.

Rishek
05-30-2017, 07:39 PM
Thanks loads!

I gave the first one a good look today, but didn't have the time necessary to implement and test it fully. I'll probably need to think about how to deal with those pesky events without and end time (either adding people to an event (ADD), taking them out of one (REL) or simply denoting the start time of something.

Will let you know in the next few days how I get one. Again, really above and beyond on this one.

mdmackillop
05-31-2017, 04:19 AM
Happy to help.
I noticed that there is a "Chen" and a "Chen " in the result. You should add a line to Trim all names in Sheet 1 prior to processing.

Rishek
05-31-2017, 09:57 AM
So I've got it up and running. Is timesplit() intended to run straight after the excel template opens the Schedule Workbook? Running it manually afterwards is fine, it isolates the entries without end times so that I can delete or tweak them.

The opened workbook also seems to delete the formatting list saved in the template. I get a different set of colors and no abbreviations. I can enter them manually.

Finally, although it's all correct, it's giving me an error 91 on the line


wsL.Cells(c.Row, S) = cel.Offset(, 1)

mdmackillop
05-31-2017, 10:33 AM
Timesplit is set to run when the workbook is created by word. Remove this line (xlapp.Run "TimeSplit") from the Word macro to prevent that.
Timesplit calls the HideRows macro (Call HideRows(Lastrow)).
HideRows: This macro does 3 things
1) it deletes entries which in Column B refer to a day other than that of the schedule.
2) it deletes entries which have neither Start nor End times
3) It hides rows containing a start and end time, leaving those rows with one missing item for correction.
CheckData ( If Not CheckData Then Exit Sub) prevents Schedules from running if data is not complete. There are other ways to handle missing data to prevent the code crashing, but I've not looked at that

Error 91: I'm not seeing that. Do you get that on the testing Word Doc or are you using a different version. If the former, what is the value of cel at the breakdown?

In the zip version, Colours and Abbreviations are on the Format sheet which should not be affected by the code. This could be stored in a separate file which might make its maintenance easier.

mdmackillop
05-31-2017, 02:04 PM
Hi
Quiet day on the forum so I played around a bit.
This version leaves the SplitTime as a separate operation in the Excel workbook. I've also moved the Format sheet to a separate workbook. As you will see, Events can be placed in any position; no need to be sequential.
I tweaked the Word document to add a separate 2 cell table for the Header & Date. the previous version relied on 2 tabs and spacing which could easily be changed.

Rishek
06-01-2017, 06:11 AM
Thanks! I'll test it later today.

Rishek
06-01-2017, 10:20 AM
Got it to work on some different data.

Things I've had to do: I have to cut and paste new data into the .dotm file. Somehow I can't get the macro to copy over. Not the worst thing in the world: it means that I won't accidentally delete the data I need.

Formatting does have to be perfect, meaning a few things need to be adjusted by hand, namely: no end dates, no conflicts or perceived conflicts (I add and release people from rehearsal, but if for instance, someone has a 2-5pm call, is then released at 3pm, I have to edit the numbers for both the original 2-5 to read 2-3 for that person and delete the data related to the release. I also often don't put a location for these items, which the program doesn't hugely like. Have to add it manually or delete the line, otherwise the create schedules macro will error on the location sheet.

Also, a weird one: when I click time split, it hides the data until I click create schedules.

Now I just have to get the resulting charts to fit on a printable are of maximally two "tabloid" sheets (11" x 17", like weird A3. Yes, I hate both our paper sizes, our date format and our use of AM/PM. They all make my job harder.).

I'm calling this a definite WIN. Thanks!!!

mdmackillop
06-01-2017, 11:03 AM
The dotm should not contain any data. Create a dotm from the docm we've been working with. A new document based upon the dotm will give access to the macro in the template.

It would be simple to add "Undefined" or whatever to any blank locations. This could be a white background in the formatting.


Also, a weird one: when I click time split, it hides the data until I click create schedules.
This was by design; hide items with start and end times leaving those items with missing data. Easily changed to omit this.

If you have to edit data, I would suggest a userform to simplify data display/entry. Looks more impressive too.

You could also use a freezepanes set on each sheet for easier viewing of data.

Rishek
06-01-2017, 08:05 PM
Going to mark this as solved. Because it is. Big time. If I have further questions, I'll start a new thread and be specific! Again, cheers. If I can just solve the last few implementation quirks, this is a huge help. It's picking up errors really well and the chart looks great when I get it.

Thanks again!

mdmackillop
06-01-2017, 11:23 PM
When I looked at the exported data there seemed some name errors. Try doing a search and replace of Para marks with ", Para" and "(" with ", (" These change=s need not be saved in the Word Doc.

Rishek
06-02-2017, 04:39 AM
I run the format to extract script before hand which fixes most of these types of things. Or did you mean in the code itself?

Rishek
06-02-2017, 12:39 PM
So I'm getting a '1004' error for the row function '_Global' when I try to run Create Schedules from the excel file.

The data seems fine, there are no blank boxes. Debug points me to the GetFormat () sub. Maybe separating out the Schedule Format book was a bridge too far?

mdmackillop
06-03-2017, 01:05 AM
Re post 14; If you search Snape in the Data worksheet you'll see it comes after Blinkley. This is because of the Para separation. The Word code needs a comma.

Re post 24; Is ScheduleFormat in the same folder? Try this simplified code to test for a result.

Sub GetFormats2()
Set wbF = Workbooks.Open(ActiveWorkbook.Path & "\ScheduleFormat.xlsx")
MsgBox wbF.Name
End Sub

We can also try building in a "delay"

Sub GetFormats()
Dim i
Set wbF = Workbooks.Open(ActiveWorkbook.Path & "\ScheduleFormat.xlsx")
For i = 1 To 100
DoEvents
Next
ActiveWindow.Visible = False
With wbF.Sheets("Format")
Set rFormat = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
End Sub

Rishek
06-03-2017, 03:40 PM
I have solved the parentheses problem differently using the FormattoExtract macro to delete and alter the formatting so the names are extracted correctly.

Had some issues today, but got as far as a timesplit with no conflicts.

19381
19382

I can't get the schedules macro to work. Either some of the data is bad, but I haven't noticed or it may be an issue with events that start at the same time that the previous event has ended?

Thoughts appreciated.

mdmackillop
06-03-2017, 03:44 PM
This processes a copy of the Word table within excel if you want an alternative to try. Maybe e a little simpler to adjust for corrections.

Rishek
06-06-2017, 09:57 AM
To be honest, the extraction is working pretty well and the workflow is pretty set for the time being. I'm not sure why the data I attached above isn't working for making schedules. I suspect it has to do with redundant locations possible (WH can be used by more than one person and event at the same time) at least for the locations grid, but it typically errors out before it even gets that far.

I'm now hoping to add yet another check to the timesplit macro to insert an I column: =IF(AND(A2=A3,D2<>D3,F2=E3),"Travel Time!","")

Basically, if a given person ($A) has an event that is not in the same column that is not at the same location ($D), they are (with a few exceptions) going to have a problem if there is not space between the end time of the previous event ($F) and the start time ($E). Similar to the conflict finding macro, but possibly best to put it in yellow. I haven't parsed how to translate this into VBA yet.

Any help as always, appreciated.

mdmackillop
06-07-2017, 12:30 AM
Re Post #26; XER was missing from Schedule format.
Replace the Events code with this which will apply a black fill with white text (first three characters) to the missing items

'Event
Set Fnd = rFormat.Find(Evnt)
If Not Fnd Is Nothing Then
Cells(c.Row, S).Resize(, E - S + 1).Interior.ColorIndex = Fnd.Offset(, 1).Interior.ColorIndex
If E - S > 1 Then Cells(c.Row, S + 1).Resize(, E - S - 1) = Fnd.Offset(, 2)
Else
Cells(c.Row, S).Resize(, E - S + 1).Interior.ColorIndex = 1
If E - S > 1 Then Cells(c.Row, S + 1).Resize(, E - S - 1) = Left(Evnt, 3)
If E - S > 1 Then Cells(c.Row, S + 1).Resize(, E - S - 1).Font.ColorIndex = 2
End If


Re Post #28: add the H2 & H1 lines as shown to highlight Travel time issues

With .Range("G2").Resize(Lastrow - 1)
.FormulaR1C1 = "=IF(RC1<>R[1]C1,SUMPRODUCT(--(R2C1:R" & Lastrow & "C1=RC1),IF(R2C6:R" & Lastrow & "C6="""",1,R2C6:R" & Lastrow & "C6)-R2C5:R" & Lastrow & "C5),"""")"
'.FormulaR1C1 = "=IF(RC1<>R[1]C1,SUMPRODUCT(--(R2C1:R137C1=RC1),IF(R2C6:R137C6="""",1,R2C6:R137C6)-R2C5:R137C5),"""")"
.NumberFormat = "hh:mm"
End With
.Range("H2").Resize(Lastrow).FormulaR1C1 = "=IF(AND(RC[-7]=R[1]C[-7],RC[-4]<>R[1]C[-4],RC[-2]=R[1]C[-3]),""Travel Time!"","""")"
.Range("H1").FormulaR1C1 = "=IF(COUNTIF(R[1]C:R[8]C,""Travel time!"")>0,""Travel Time Issues"","""")"
End With

Rishek
06-07-2017, 05:05 AM
Cheers. Sorry this has taken so much back and forth. Will implement this all today.

After that comes the streamlining ...

mdmackillop
06-09-2017, 07:24 AM
Cheers. Sorry this has taken so much back and forth. Will implement this all today.

After that comes the streamlining ...

As XLD (http://www.vbaexpress.com/forum/member.php?2139-xld) says
Nihil simul inventum est et perfectum

Rishek
06-09-2017, 09:06 AM
So everything is working quite well.

Haven't quite sorted the travel time item, but I will (it's not a priority and once I'm at work, there's actually not a lot of time to test things).

General points:

1) The crosscheck is great, but I need to figure out a way to account for people whose names do NOT appear on the schedule, i.e. have NO commitments. For now, I'll just be copying a list of those I need to check onto the extracted data and giving them a commitment that takes no time.

2) I will probably have to perform a separate cross check with the locations. I did manage to modify the original code to do this. Similarly, I need to be able to check what spots have NO people in them, but this is a lot easier.

3) As long as nobody and nowhere is double booked, I actually only need to extract certain names and locations for the chart. This might printing the damn thing a might easier (currently I'm deleting the dinner hour and doing some creative rescaling, but legibility is a factor).

4) Haven't got the Travel time addition up and running yet. Rather a lot running across my plate at the moment.

Would like to note: we haven't had a double booking since I started doing this.

Rishek
06-14-2017, 10:05 AM
So I'm trying to get the travel time issues to appear in yellow in column D. I'm trying to add this code to the HighlightProblems macro:


With ws.Columns("D:D")
.FormatConditionsAdd Type:=xlExpression, Forumula1:="AND($A1=$A2,$D1<>$D2,$F1=$E2)"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ColorIndex = 6
.TintAndShade = 0
End With
Range("D1:D1").FormatConditions.Delete
End With

But it does not like that one bit. Any advice? I actually don't need the text in column H or I as long as the errors are highlighted.

mdmackillop
06-14-2017, 11:42 AM
Forumula1:

Pulled together.

Rishek
06-14-2017, 01:38 PM
Thanks. Played around with this a whole bunch until I realized the formula was switched up: $F1>=$E2, not <=. Now works great.