Staff Booking Schedule

[scionthelast]

I'm putting together a custom resource sheet. I want to neatly list the bookings for a particular person on a particular date.
I am inserting the correct amount on new rows for a resource, then placing the name of the project they are working on in the cell (for a given date).
The problem is handling multiple bookings for a single person on a single day. At present my script adds news lines in, but if the person already has enough rows beneath their name there is no need to insert new ones.
I'd like to neatly print out the bookings for each day, and only insert new rows for a given resource if there are not already enough....
You can grab the example xlsm file from herehttps://www.dropbox.com/s/vwfvo4mxl72bv21/Resource.xlsm
I've uploaded an example of how I'd like to look here:https://www.dropbox.com/s/1bfmeex96bq6ra1/Resource_ShouldLookLike.xlsm
sheet 2 has a database export which I'm checking against sheet 3 where i'd like the resource schedule printed out

<code style="margin: 0px; padding: 0px; border: 0px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif;">[COLOR=#00008B]Sub[/COLOR] UpdateSchedule()Application.ScreenUpdating = [COLOR=#800000]False[/COLOR][COLOR=#00008B]Dim[/COLOR] xmlOutput [COLOR=#00008B]As[/COLOR] Range[COLOR=#00008B]Dim[/COLOR] ResourceNames [COLOR=#00008B]As[/COLOR] Range[COLOR=#00008B]Dim[/COLOR] a [COLOR=#00008B]As[/COLOR] Range [COLOR=gray]' resource names[/COLOR][COLOR=#00008B]Dim[/COLOR] b [COLOR=#00008B]As[/COLOR] Range [COLOR=gray]' export names[/COLOR][COLOR=#00008B]Dim[/COLOR] namecount [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]Integer[/COLOR][COLOR=#00008B]Dim[/COLOR] e [COLOR=#00008B]As[/COLOR] Range[COLOR=#00008B]With[/COLOR] Sheets([COLOR=#800000]"Sheet3"[/COLOR])    [COLOR=#00008B]Set[/COLOR] ResourceNames = .Range(.Cells([COLOR=#800000]2[/COLOR], [COLOR=#800000]1[/COLOR]), .Cells([COLOR=#800000]2[/COLOR], [COLOR=#800000]1[/COLOR]).[COLOR=#00008B]End[/COLOR](xlDown))    [COLOR=gray]'Debug.Print ResourceNames.Address[/COLOR][COLOR=#00008B]End[/COLOR] [COLOR=#00008B]With[/COLOR][COLOR=#00008B]With[/COLOR] Sheets([COLOR=#800000]"Sheet2"[/COLOR])    [COLOR=#00008B]Set[/COLOR] xmlOutput = .Range(.Cells([COLOR=#800000]2[/COLOR], [COLOR=#800000]3[/COLOR]), .Cells([COLOR=#800000]2[/COLOR], [COLOR=#800000]3[/COLOR]).[COLOR=#00008B]End[/COLOR](xlDown))    [COLOR=gray]'Debug.Print xmlOutput.Address[/COLOR][COLOR=#00008B]End[/COLOR] [COLOR=#00008B]With[/COLOR][COLOR=#00008B]With[/COLOR] Sheets([COLOR=#800000]"Sheet3"[/COLOR])    [COLOR=gray]' Check the names in the schedule one by one[/COLOR]    [COLOR=#00008B]For[/COLOR] [COLOR=#00008B]Each[/COLOR] a [COLOR=#00008B]In[/COLOR] ResourceNames    [COLOR=#00008B]If[/COLOR] a.Value > [COLOR=#800000]0[/COLOR] [COLOR=#00008B]Then[/COLOR] .Rows(a.Row + [COLOR=#800000]1[/COLOR]).Insert        [COLOR=gray]'Look for matches in the xml output from Rap[/COLOR]        [COLOR=#00008B]For[/COLOR] [COLOR=#00008B]Each[/COLOR] b [COLOR=#00008B]In[/COLOR] xmlOutput            [COLOR=#00008B]If[/COLOR] b.Value > [COLOR=#800000]0[/COLOR] [COLOR=#00008B]And[/COLOR] a.Value > [COLOR=#800000]0[/COLOR] [COLOR=#00008B]And[/COLOR] b.Value = a.Value [COLOR=#00008B]Then[/COLOR]                        [COLOR=gray]'Look for date matches[/COLOR]                        [COLOR=#00008B]For[/COLOR] [COLOR=#00008B]Each[/COLOR] e [COLOR=#00008B]In[/COLOR] .Range(.Cells([COLOR=#800000]1[/COLOR], [COLOR=#800000]2[/COLOR]), .Cells([COLOR=#800000]1[/COLOR], [COLOR=#800000]2[/COLOR]).[COLOR=#00008B]End[/COLOR](xlToRight))                            [COLOR=#00008B]If[/COLOR] e.Value = b.Offset([COLOR=#800000]0[/COLOR], -[COLOR=#800000]2[/COLOR]).Value [COLOR=#00008B]Then[/COLOR]                                nn = WorksheetFunction.CountIfs(xmlOutput.Offset([COLOR=#800000]0[/COLOR], -[COLOR=#800000]2[/COLOR]), e.Value, xmlOutput, a.Value)                                [COLOR=#00008B]If[/COLOR] nn > [COLOR=#800000]1[/COLOR] [COLOR=#00008B]Then[/COLOR]                                i = i + [COLOR=#800000]1[/COLOR]                                .Rows(a.Row + [COLOR=#800000]1[/COLOR]).Insert                                [COLOR=#00008B]Else[/COLOR]                                [COLOR=#00008B]End[/COLOR] [COLOR=#00008B]If[/COLOR]                                .Cells(a.Row + [COLOR=#800000]1[/COLOR], e.Column).Value = b.Offset([COLOR=#800000]0[/COLOR], [COLOR=#800000]3[/COLOR]).Value                            [COLOR=#00008B]Else[/COLOR]: [COLOR=#00008B]End[/COLOR] [COLOR=#00008B]If[/COLOR]                        [COLOR=#00008B]Next[/COLOR] e            [COLOR=#00008B]Else[/COLOR]: [COLOR=#00008B]End[/COLOR] [COLOR=#00008B]If[/COLOR]        [COLOR=#00008B]Next[/COLOR] b    i = [COLOR=#800000]0[/COLOR]    nn = [COLOR=#800000]0[/COLOR]    [COLOR=#00008B]Next[/COLOR] a[COLOR=#00008B]End[/COLOR] [COLOR=#00008B]With[/COLOR]Application.ScreenUpdating = [COLOR=#800000]True[/COLOR][COLOR=#00008B]End[/COLOR] [COLOR=#00008B]Sub[/COLOR]</code></pre>