Find a date and copy the data to other formated worksheet

J

Jasmine Shine

New Member
Joined
Nov 4, 2015
Messages
6
Hi All,
I always get the information as on the table below:
01/12/2015</SPAN>04/12/2015</SPAN>05/12/2015</SPAN>11/12/2015</SPAN>13/12/2015</SPAN>14/12/2015</SPAN>17/12/2015</SPAN>20/12/015</SPAN>23/12/2015</SPAN>
John H.</SPAN>Depart</SPAN>Steve </SPAN>Depart</SPAN>John H.</SPAN>Arrive</SPAN>John H. </SPAN>Depart</SPAN>John H.</SPAN>Arrive</SPAN>Steve</SPAN>Arrive</SPAN>Steve </SPAN>Depart</SPAN>John H.</SPAN>Depart</SPAN>John H.</SPAN>Arrive</SPAN>
London </SPAN> Dublin</SPAN> London Edinburgh</SPAN> Edinburgh</SPAN> Dublin</SPAN> Belfast</SPAN> Galway</SPAN> Galway</SPAN>
Tom C.</SPAN>Depart</SPAN>Tom C.</SPAN>Arrive</SPAN>Tom C.</SPAN>Depart</SPAN>Tom C.</SPAN>Arrive</SPAN>Steve</SPAN>Arrive</SPAN>
Cork</SPAN> Cork</SPAN> Amsterdam</SPAN>Amsterdam</SPAN>Belfast</SPAN>

<TBODY>
</TBODY><COLGROUP><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL span=3><COL><COL></COLGROUP>







And i need to change the information to the schedule as on the calendar with the composition as on the table below, so we will know if somebody will be offisite on certains date.


Dec 2015</SPAN>
Sun</SPAN> Mon</SPAN> Tue</SPAN> Wed</SPAN> Thurs</SPAN> Fri</SPAN> Sat</SPAN>
1</SPAN> 2</SPAN> 3</SPAN> 4</SPAN> 5</SPAN> 6</SPAN>
John H.</SPAN>Depart</SPAN> John H.</SPAN>Arrive</SPAN>
London </SPAN> London
Tom C.</SPAN>Depart</SPAN> Tom C.</SPAN>Arrive</SPAN>
Cork</SPAN> Cork</SPAN>
Steve </SPAN>Depart</SPAN>
Dublin</SPAN>
7</SPAN> 8</SPAN> 9</SPAN> 10</SPAN> 11</SPAN> 12</SPAN> 13</SPAN>
John H.</SPAN>Depart</SPAN> John H.</SPAN>Arrive</SPAN>
Edinburgh</SPAN> Edinburgh</SPAN>
Tom C.</SPAN>Depart</SPAN>
Amsterdam</SPAN>
14</SPAN> 15</SPAN> 16</SPAN> 17</SPAN> 18</SPAN> 19</SPAN> 20</SPAN>
Steve </SPAN>Depart</SPAN> Steve </SPAN>Arrive</SPAN>
Belfast</SPAN> Belfast</SPAN>
Tom C.Arrive John H.</SPAN>Depart</SPAN>
Amsterdam Galway</SPAN>
Steve </SPAN>Arrive</SPAN>
Dublin</SPAN>
21</SPAN> 22</SPAN> 23</SPAN> 24</SPAN> 25</SPAN> 26</SPAN> 27</SPAN>
John H.</SPAN>Arrive</SPAN>
Galway</SPAN>
28</SPAN> 29</SPAN>

<TBODY>
</TBODY><COLGROUP><COL span=14></COLGROUP>

Many thanks in advance for your kind help.
Kind Regards,
Jas
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Sort by date Sort by votes
Q(1) Does the data you get just consist of 1 months worth
Q(2) Is it correct that each date in you data consists of 2 columns as per how the data copies to my sheet???
Q(3) Is it correct that the final Calendar needs to be constructed by the code,
because the number of rows between each week will vary depending on the umber of entries ????
 
Upvote 0
Hi MickG,
Thank you for your reply. Please find my answers below:

1) The data is consist more than 1 month, usually 6 months in advance but could be more than that.
2)the data consist of 2 row and 2 column (the name of the person and the activities on the first row, destination on the second row)
3) we try to manage just to have max 3 person offsite at this moment, so that's how we plan it for now.

Kind regards,
Jas
 
Upvote 0
Try this on the data you sent:-
Your data sheet1, Results sheet2
Code: 
[COLOR=Navy]Sub[/COLOR] MG05Nov15
[COLOR=Navy]Dim[/COLOR] Yr              [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] mth             [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] mDay            [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] Rw              [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer,[/COLOR] Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Col             [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] mDif            [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Lst             [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] LRw [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Fdt             [COLOR=Navy]As[/COLOR] Date
[COLOR=Navy]Dim[/COLOR] Dic             [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] rRw             [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] cAc [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] mMax            [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR=Navy]With[/COLOR] Sheets("Sheet1")
    Lst = .Cells("1", Columns.Count).End(xlToLeft).Column
    LRw = .Range("A" & Rows.Count).End(xlUp).Row
    mDif = DateDiff("m", .Cells(1, 1), .Cells(1, Lst)) + 1
    Fdt = DateSerial(Year(.Range("a1").Value), Month(.Range("A1").Value), "1")
        ReDim ray(1 To 6 * LRw, 1 To 14)
[COLOR=Navy]For[/COLOR] mDay = 1 To 7
   ray(1, mDay + mDay - 1) = WeekdayName(mDay, True, 1)
[COLOR=Navy]Next[/COLOR] mDay
Col = 8
Rw = 2
[COLOR=Navy]Select[/COLOR] [COLOR=Navy]Case[/COLOR] Month(Fdt)
    [COLOR=Navy]Case[/COLOR] 2: mMax = IIf(Year(Fdt) Mod 4 = 0, 29, 28)
    [COLOR=Navy]Case[/COLOR] 4, 6, 9, 11: mMax = 30
    [COLOR=Navy]Case[/COLOR] Else: mMax = 31
[COLOR=Navy]End[/COLOR] Select
[COLOR=Navy]For[/COLOR] mDay = 1 To 31
    Col = Weekday(DateSerial(Year(Fdt), Month(Fdt), mDay))
    ray(Rw, Col + Col - 1) = mDay
     Dic.Add mDay, Array(Rw, Col + Col - 1)
            Rw = Rw + IIf(Col Mod 7 = 0, 6, 0)
                [COLOR=Navy]If[/COLOR] mDay = mMax [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Exit[/COLOR] For
[COLOR=Navy]Next[/COLOR] mDay
[COLOR=Navy]For[/COLOR] Rw = 1 To LRw - 1 [COLOR=Navy]Step[/COLOR] 2
    [COLOR=Navy]For[/COLOR] Ac = 1 To Lst [COLOR=Navy]Step[/COLOR] 2
        [COLOR=Navy]If[/COLOR] Dic.exists(Day(.Cells(1, Ac))) [COLOR=Navy]Then[/COLOR]
            rRw = Dic(Day(.Cells(1, Ac)))(0)
            cAc = Dic(Day(.Cells(1, Ac)))(1)
            ray(rRw + Rw, cAc) = .Cells(Rw + 1, Ac)
            ray(rRw + Rw + 1, cAc) = .Cells(Rw + 2, Ac)
            ray(rRw + Rw, cAc + 1) = .Cells(Rw + 1, Ac + 1)
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] Ac
[COLOR=Navy]Next[/COLOR] Rw
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]With[/COLOR] Sheets("Sheet2").Range("A2").Resize(6 * LRw, 14)
    .Parent.Range("A1").Value = Format(Fdt, "mmm-yyyy")
    .Parent.Range("A1").Font.Bold = True
    .Value = ray
    .Columns.AutoFit
    .Borders.Weight = 2
    .Font.Bold = True
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
I did note that your results show "1/12/2015" as a Monday whereas my Calendar shows it as a "Tuesday" ???
 
Upvote 0
Hi MickG.
Thank you so much for your reply, really appreciate it. It works perfectly.
Could you please advise how to add and extra line on the file, as sometime we have 3 people data on 1 day?
When i add extra data from Jan 2016, it also won't pick up the data.

About the 1 Dec 2015, it was my mistake in copy paste the file.


Once again thank you so much for your kind help.
Kind Regards,
Jas
 
Upvote 0
When you have extra months, are they added as a continuation across the columns or added in new sets of rows (dates & data) down the sheet.
When you have a number of months will all the dates increase progressively i.e month to month and Year to Year
Please show an Example if Possible !!!
 
Last edited:
Upvote 0
Hi MickG,
Apologies for the confusion.
So basically, i will collected the data at the list below

01/12/2015</SPAN>05/12/2015</SPAN>11/12/2015</SPAN>13/12/2015</SPAN>20/12/015</SPAN>23/12/2015</SPAN>05/01/2016</SPAN>08/01/2016</SPAN>
John H.</SPAN>Depart</SPAN>John H.</SPAN>Arrive</SPAN>John H. </SPAN>Depart</SPAN>John H.</SPAN>Arrive</SPAN>John H.</SPAN>Depart</SPAN>John H.</SPAN>Arrive</SPAN>John H.</SPAN>Depart</SPAN>John H.</SPAN>Arrive</SPAN>
London </SPAN>London</SPAN>Edinburgh</SPAN>Edinburgh</SPAN>Galway</SPAN>Galway</SPAN>Dublin</SPAN>Dublin</SPAN>
01/12/2015</SPAN>05/12/2015</SPAN>13/12/2015</SPAN>23/12/2015</SPAN>
Tom C.</SPAN>Depart</SPAN>Tom C.</SPAN>Arrive</SPAN>Tom C.</SPAN>Depart</SPAN>Tom C.</SPAN>Arrive</SPAN>
Cork</SPAN>Cork</SPAN>Amsterdam</SPAN>Amsterdam</SPAN>
01/12/2015</SPAN>05/12/2015</SPAN>
Becky </SPAN>Depart</SPAN>Becky </SPAN>Arrive</SPAN>
Paris</SPAN>Paris</SPAN>
04/12/2015</SPAN>14/12/2015</SPAN>17/12/2015</SPAN>20/12/2015</SPAN>
Steve </SPAN>Depart</SPAN>Steve</SPAN>Arrive</SPAN>Steve </SPAN>Depart</SPAN>Steve </SPAN>Arrive</SPAN>
Dublin</SPAN>Dublin</SPAN>Belfast</SPAN>Belfast</SPAN>
26/12/2015</SPAN>03/01/2015</SPAN>
Jerome</SPAN>Depart</SPAN>Jerome</SPAN>Arrive</SPAN>
Bangkok</SPAN>Bangkok</SPAN>
27/12/2015</SPAN>Jerome</SPAN>
Jackie</SPAN>Depart</SPAN>Jackie</SPAN>Arrive</SPAN>
Singapore</SPAN>Singapore</SPAN>
27/12/2015</SPAN>03/01/2015</SPAN>12/01/2016</SPAN>17/01/2016</SPAN>
Maggie</SPAN>Depart</SPAN>Maggie</SPAN>Arrive</SPAN>Maggie</SPAN>Depart</SPAN>Maggie</SPAN>Arrive</SPAN>
New York</SPAN>New York</SPAN>New York</SPAN>New York</SPAN>
09/01/2016</SPAN>22/01/2016</SPAN>
John B.</SPAN>Depart</SPAN>John B.</SPAN>Arrive</SPAN>
Havana</SPAN>Havana</SPAN>
09/01/2016</SPAN>16/01/2016</SPAN>
Charllote</SPAN>Depart</SPAN>Charllote</SPAN>Arrive</SPAN>
Boston</SPAN>Boston</SPAN>

<TBODY>
</TBODY><COLGROUP><COL><COL><COL><COL><COL><COL><COL><COL span=3><COL><COL><COL><COL><COL><COL><COL></COLGROUP>


I found a macro on the internet to collecting data above to be 1 line data as i showed on the first message. Now i need to put the data on the calendar look.
I tried to keep the arrival data at the same row on the departure data so i can see if we already sent 3 people on that day or i can add another one. I highlighted the data on December with different colors so it can show the difference.
December 2015</SPAN>
Sun</SPAN> Mon</SPAN> Tue</SPAN> Wed</SPAN> Thurs</SPAN> Fri</SPAN> Sat</SPAN>
1</SPAN> 2</SPAN> 3</SPAN> 4</SPAN> 5</SPAN>
John H.</SPAN>Depart</SPAN> John H.</SPAN>Arrive</SPAN>
London </SPAN> London</SPAN>
Tom C.</SPAN>Depart</SPAN> Tom C.</SPAN>Arrive</SPAN>
Cork</SPAN> Cork</SPAN>
Becky </SPAN>Depart</SPAN> Becky </SPAN>Arrive</SPAN> Steve </SPAN>Depart</SPAN>
Paris</SPAN> Paris</SPAN> Dublin</SPAN>
6</SPAN> 7</SPAN> 8</SPAN> 9</SPAN> 10</SPAN> 11</SPAN> 12</SPAN>
John H. </SPAN>Depart</SPAN>
Edinburgh</SPAN>
Tom C.</SPAN>Depart</SPAN>
Amsterdam</SPAN>
13</SPAN> 14</SPAN> 15</SPAN> 16</SPAN> 17</SPAN> 18</SPAN> 19</SPAN>
John H.</SPAN>Arrive</SPAN> Steve </SPAN>Depart</SPAN>
Edinburgh</SPAN> Belfast</SPAN>
Tom C.</SPAN>Arrive</SPAN>
Amsterdam</SPAN>
Steve</SPAN>Arrive</SPAN>
Dublin</SPAN>
20</SPAN> 21</SPAN> 22</SPAN> 23</SPAN> 24</SPAN> 25</SPAN> 26</SPAN>
Steve</SPAN>Arrive</SPAN> Jerome</SPAN>Depart</SPAN>
Belfast</SPAN> Bangkok</SPAN>
John H.</SPAN>Depart</SPAN> John H.</SPAN>Arrive</SPAN>
Galway</SPAN> Galway</SPAN>
27</SPAN> 28</SPAN> 29</SPAN> 30</SPAN> 31</SPAN>
Jackie</SPAN>Depart</SPAN>
Singapore</SPAN>
Maggie</SPAN>Depart</SPAN>
New York</SPAN>
January 2016</SPAN>
Sun</SPAN> Mon</SPAN> Tue</SPAN> Wed</SPAN> Thurs</SPAN> Fri</SPAN> Sat</SPAN>
1</SPAN> 2</SPAN>
3</SPAN> 4</SPAN> 5</SPAN> 6</SPAN> 7</SPAN> 8</SPAN> 9</SPAN>
Jerome</SPAN>Arrive</SPAN> John H.</SPAN>Depart</SPAN> John H.</SPAN>Arrive</SPAN> John B.</SPAN>Depart</SPAN>
Bangkok</SPAN> Dublin</SPAN> Galway</SPAN> Havana</SPAN>
Jackie</SPAN>Arrive</SPAN> Charllote</SPAN>Depart</SPAN>
Singapore</SPAN> Boston</SPAN>
Maggie</SPAN>Arrive</SPAN>
New York</SPAN>
10</SPAN> 11</SPAN> 12</SPAN> 13</SPAN> 14</SPAN> 15</SPAN> 16</SPAN>
Charllote</SPAN>Arrive</SPAN>
Boston</SPAN>
Maggie</SPAN>Depart</SPAN>
New York</SPAN>
17</SPAN> 18</SPAN> 19</SPAN> 20</SPAN> 21</SPAN> 22</SPAN> 23</SPAN>
John B.</SPAN>Arrive</SPAN>
Havana</SPAN>
Maggie</SPAN>Arrive</SPAN>
New York</SPAN>
24</SPAN> 25</SPAN> 26</SPAN> 27</SPAN> 28</SPAN> 29</SPAN> 30</SPAN>
31</SPAN>

<TBODY>
</TBODY><COLGROUP><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL></COLGROUP>

<TBODY>
</TBODY><COLGROUP><COL><COL><COL><COL><COL><COL><COL><COL span=3><COL><COL><COL><COL><COL><COL><COL></COLGROUP>




I found a macro to create calendar but i can't find the macro to populate the data to "that calendar". So please feel free to chage the flow of the work and thank you so so much for your kind help.

Kind Regards,
Jas
 
Upvote 0
Try this (Based on your most recent Data) for results on sheet2.
Code: 
[COLOR=Navy]Sub[/COLOR] MG07Nov24
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] k [COLOR=Navy]As[/COLOR] Variant, p [COLOR=Navy]As[/COLOR] Variant, oMax [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Ray [COLOR=Navy]As[/COLOR] Variant, nDt [COLOR=Navy]As[/COLOR] Date, R [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Yr [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer,[/COLOR] mth  [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer,[/COLOR] mDay [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] Rw [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer,[/COLOR] Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Col [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] mDif [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Lst [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] LRw [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Fdt [COLOR=Navy]As[/COLOR] Date, Dic [COLOR=Navy]As[/COLOR] Object, oSet [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] rRw [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] cAc [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] mMax [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer,[/COLOR] c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
oSet = 0
[COLOR=Navy]Set[/COLOR] Rng = ActiveSheet.UsedRange
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
  [COLOR=Navy]If[/COLOR] IsDate(Dn.Value) [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]If[/COLOR] Not Dic.exists(Month(Dn.Value) & "_" & Year(Dn.Value)) [COLOR=Navy]Then[/COLOR]
                [COLOR=Navy]Set[/COLOR] Dic(Month(Dn.Value) & "_" & Year(Dn.Value)) = CreateObject("Scripting.Dictionary")
            [COLOR=Navy]End[/COLOR] If
        
        [COLOR=Navy]If[/COLOR] Not Dic(Month(Dn.Value) & "_" & Year(Dn.Value)).exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
                Dic(Month(Dn.Value) & "_" & Year(Dn.Value)).Add Dn.Value, Dn
        [COLOR=Navy]Else[/COLOR]
                [COLOR=Navy]Set[/COLOR] Dic(Month(Dn.Value) & "_" & Year(Dn.Value)).Item(Dn.Value) = _
                Union(Dic(Month(Dn.Value) & "_" & Year(Dn.Value)).Item(Dn.Value), Dn)
        [COLOR=Navy]End[/COLOR] If
   [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] k [COLOR=Navy]In[/COLOR] Dic.keys
       [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] p [COLOR=Navy]In[/COLOR] Dic(k)
             oMax = Application.Max(Dic(k).Item(p).Count, oMax)
        [COLOR=Navy]Next[/COLOR] p
    
        Fdt = DateSerial(Split(k, "_")(1), Split(k, "_")(0), "1")
         ReDim Ray(1 To 6 * oMax * 2 + 2, 1 To 14)
            Ray(1, 1) = Format(Fdt, "mmm-yyyy")
[COLOR=Navy]For[/COLOR] mDay = 1 To 7
   Ray(2, mDay + mDay - 1) = WeekdayName(mDay, True, 1)
[COLOR=Navy]Next[/COLOR] mDay


Col = 8: Rw = 3
[COLOR=Navy]Select[/COLOR] [COLOR=Navy]Case[/COLOR] Month(Fdt)
    [COLOR=Navy]Case[/COLOR] 2: mMax = IIf(Year(Fdt) Mod 4 = 0, 29, 28)
    [COLOR=Navy]Case[/COLOR] 4, 6, 9, 11: mMax = 30
    [COLOR=Navy]Case[/COLOR] Else: mMax = 31
[COLOR=Navy]End[/COLOR] Select


[COLOR=Navy]For[/COLOR] mDay = 1 To 31
    Col = Weekday(DateSerial(Year(Fdt), Month(Fdt), mDay))
       Ray(Rw, Col + Col - 1) = mDay
            Rw = Rw + IIf(Col Mod 7 = 0, oMax * 2 + 1, 0)
                [COLOR=Navy]If[/COLOR] mDay = mMax [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Exit[/COLOR] For
[COLOR=Navy]Next[/COLOR] mDay


[COLOR=Navy]For[/COLOR] Rw = 1 To UBound(Ray, 1)
    [COLOR=Navy]For[/COLOR] Ac = 1 To UBound(Ray, 2)
        [COLOR=Navy]If[/COLOR] IsNumeric(Ray(Rw, Ac)) And Not IsEmpty(Ray(Rw, Ac)) [COLOR=Navy]Then[/COLOR]
      nDt = DateSerial(Split(k, "_")(1), Split(k, "_")(0), Ray(Rw, Ac))
        [COLOR=Navy]If[/COLOR] Dic(k).exists(DateSerial(Split(k, "_")(1), Split(k, "_")(0), Ray(Rw, Ac))) [COLOR=Navy]Then[/COLOR]
c = 1
          [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] Dic(k).Item(nDt)
            Ray(Rw + c, Ac) = R.Offset(1)
            Ray(Rw + c + 1, Ac) = R.Offset(2)
            Ray(Rw + c, Ac + 1) = R.Offset(1, 1)
            c = c + 2
        [COLOR=Navy]Next[/COLOR] R
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] Ac
[COLOR=Navy]Next[/COLOR] Rw
[COLOR=Navy]With[/COLOR] Sheets("Sheet2").Range("A1").Offset(oSet).Resize(6 * oMax * 2 + 2, 14)
   .Value = Ray
    .Columns.AutoFit
    .Borders.Weight = 2
    .Font.Bold = True
[COLOR=Navy]End[/COLOR] With
oSet = oSet + 6 * oMax * 2 + 2
[COLOR=Navy]Next[/COLOR] k
'[COLOR=Green][B]#######[/B][/COLOR]
'[COLOR=Green][B]Remove The code below if colours not required[/B][/COLOR]
[COLOR=Navy]With[/COLOR] Sheets("Sheet2")
[COLOR=Navy]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] Dn.Value = "Sun" [COLOR=Navy]Then[/COLOR]
        c = 0
        Dn.Resize(, 14).Interior.Color = vbGreen
    [COLOR=Navy]Else[/COLOR]
        [COLOR=Navy]If[/COLOR] c = 0 Or c Mod 7 = 0 [COLOR=Navy]Then[/COLOR]
            Dn.Resize(, 14).Interior.Color = vbYellow
        [COLOR=Navy]End[/COLOR] If
    c = c + 1
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
'[COLOR=Green][B]#######[/B][/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Mick,
I can't take you enough for your kind help with the code.
The code is brilliant and works like a charm. Thank you!

Since I am new with VBA and has no coding background, i try to understand the code by changing the data and code and see how is the result.
Unfortunately i don't understand the code, it's way too advanced for me.
Would you mind if you create the code for different configuration (i only change the amount of the column of data from 2X2 to 3X2) so i can understand your code and i can't modify the code if i get different configuration of data.

01/12/2015</SPAN> 05/12/2015</SPAN> 11/12/2015</SPAN> 13/12/2015</SPAN> 20/12/015</SPAN> 23/12/2015</SPAN> 05/01/2016</SPAN> 08/01/2016</SPAN>
John H.</SPAN>Depart</SPAN>1234</SPAN>John H.</SPAN>Arrive</SPAN>1645</SPAN>John H. </SPAN>Depart</SPAN>2194</SPAN>John H.</SPAN>Arrive</SPAN>2925</SPAN>John H.</SPAN>Depart</SPAN>3900</SPAN>John H.</SPAN>Arrive</SPAN>5200</SPAN>John H.</SPAN>Depart</SPAN>6933</SPAN>John H.</SPAN>Arrive</SPAN>9245</SPAN>
London </SPAN>a</SPAN>bbb</SPAN>London</SPAN>c</SPAN>ccc</SPAN>Edinburgh</SPAN>d</SPAN>ddd</SPAN>Edinburgh</SPAN>ee</SPAN>fff</SPAN>Galway</SPAN>dg</SPAN>ggg</SPAN>Galway</SPAN>ee</SPAN>fff</SPAN>Dublin</SPAN>dg</SPAN>ggg</SPAN>Dublin</SPAN>ee</SPAN>fff</SPAN>
01/12/2015</SPAN> 05/12/2015</SPAN> 13/12/2015</SPAN> 23/12/2015</SPAN>
Tom C.</SPAN>Depart</SPAN>1357</SPAN>Tom C.</SPAN>Arrive</SPAN>1851</SPAN>Tom C.</SPAN>Depart</SPAN>2468</SPAN>Tom C.</SPAN>Arrive</SPAN>3291</SPAN>
Cork</SPAN>b</SPAN>bbb</SPAN>Cork</SPAN>d</SPAN>ee</SPAN>Amsterdam</SPAN>d</SPAN>w</SPAN>Amsterdam</SPAN>f</SPAN>ggg</SPAN>
01/12/2015</SPAN> 05/12/2015</SPAN>
Becky </SPAN>Depart</SPAN>1527</SPAN>Becky </SPAN>Arrive</SPAN>2082</SPAN>
Paris</SPAN>e</SPAN>eee</SPAN>Paris</SPAN>f</SPAN>ffff</SPAN>
04/12/2015</SPAN> 14/12/2015</SPAN> 17/12/2015</SPAN> 20/12/2015</SPAN>
Steve </SPAN>Depart</SPAN>1717</SPAN>Steve</SPAN>Arrive</SPAN>2343</SPAN>Steve </SPAN>Depart</SPAN>2468</SPAN>Steve </SPAN>Arrive</SPAN>3291</SPAN>
Dublin</SPAN>e</SPAN>eee</SPAN>Dublin</SPAN>F</SPAN>eee</SPAN>Belfast</SPAN>e</SPAN>eee</SPAN>Belfast</SPAN>F</SPAN>eee</SPAN>
26/12/2015</SPAN> 03/01/2015</SPAN>
Jerome</SPAN>Depart</SPAN>1932</SPAN>Jerome</SPAN>Arrive</SPAN>2636</SPAN>
Bangkok</SPAN>e</SPAN>eee</SPAN>Bangkok</SPAN>F</SPAN>eee</SPAN>
27/12/2015</SPAN> 03/01/2015</SPAN>
Jackie</SPAN>Depart</SPAN>2174</SPAN>Jackie</SPAN>Arrive</SPAN>2965</SPAN>
Singapore</SPAN>e</SPAN>eee</SPAN>Singapore</SPAN>F</SPAN>eee</SPAN>
27/12/2015</SPAN> 03/01/2015</SPAN> 12/01/2016</SPAN> 17/01/2016</SPAN>
Maggie</SPAN>Depart</SPAN>2445</SPAN>Maggie</SPAN>Arrive</SPAN>3336</SPAN>Maggie</SPAN>Depart</SPAN>2777</SPAN>Maggie</SPAN>Arrive</SPAN>3702</SPAN>
New York</SPAN>e</SPAN>eee</SPAN>New York</SPAN>F</SPAN>eee</SPAN>New York</SPAN>e</SPAN>eee</SPAN>New York</SPAN>e</SPAN>eee</SPAN>
09/01/2016</SPAN> 22/01/2016</SPAN>
John B.</SPAN>Depart</SPAN>2751</SPAN>John B.</SPAN>Arrive</SPAN>3753</SPAN>
Havana</SPAN>e</SPAN>eee</SPAN>Havana</SPAN>F</SPAN>eee</SPAN>
09/01/2016</SPAN> 16/01/2016</SPAN>
Charllote</SPAN>Depart</SPAN>3095</SPAN>Charllote</SPAN>Arrive</SPAN>4222</SPAN>
Boston</SPAN>e</SPAN>eee</SPAN>Boston</SPAN>F</SPAN>eee</SPAN>

<TBODY>
</TBODY><COLGROUP><COL><COL><COL><COL><COL><COL><COL><COL span=2><COL><COL><COL><COL><COL span=2><COL><COL span=2><COL><COL span=2><COL><COL><COL></COLGROUP>




And the result is

Dec-15</SPAN>
Sun</SPAN> Mon</SPAN> Tue</SPAN> Wed</SPAN> Thu</SPAN> Fri</SPAN> Sat</SPAN>
1</SPAN> 2</SPAN> 3</SPAN> 4</SPAN> 5</SPAN>
John H.</SPAN>Depart</SPAN>1234</SPAN> Steve </SPAN>Depart</SPAN>1717</SPAN>John H.</SPAN>Arrive</SPAN>1645</SPAN>
London </SPAN>a</SPAN>bbb</SPAN> Dublin</SPAN>e</SPAN>eee</SPAN>London</SPAN>c</SPAN>ccc</SPAN>
Tom C.</SPAN>Depart</SPAN>1357</SPAN> Tom C.</SPAN>Arrive</SPAN>1851</SPAN>
Cork</SPAN>b</SPAN>bbb</SPAN> Cork</SPAN>d</SPAN>ee</SPAN>
Becky </SPAN>Depart</SPAN>1526.6</SPAN> Becky </SPAN>Arrive</SPAN>2082</SPAN>
Paris</SPAN>e</SPAN>eee</SPAN> Paris</SPAN>f</SPAN>ffff</SPAN>
6</SPAN> 7</SPAN> 8</SPAN> 9</SPAN> 10</SPAN> 11</SPAN> 12</SPAN>
John H. </SPAN>Depart</SPAN>2194</SPAN>
Edinburgh</SPAN>d</SPAN>ddd</SPAN>
13</SPAN> 14</SPAN> 15</SPAN> 16</SPAN> 17</SPAN> 18</SPAN> 19</SPAN>
John H.</SPAN>Arrive</SPAN>2925</SPAN>Steve</SPAN>Arrive</SPAN>2343</SPAN> Steve </SPAN>Depart</SPAN>2468</SPAN>
Edinburgh</SPAN>ee</SPAN>fff</SPAN>Dublin</SPAN>F</SPAN>eee</SPAN> Belfast</SPAN>e</SPAN>eee</SPAN>
Tom C.</SPAN>Depart</SPAN>2468</SPAN>
Amsterdam</SPAN>d</SPAN>w</SPAN>
20</SPAN> 21</SPAN> 22</SPAN> 23</SPAN> 24</SPAN> 25</SPAN> 26</SPAN>
Steve </SPAN>Arrive</SPAN>3291</SPAN> John H.</SPAN>Arrive</SPAN>5200</SPAN> Jerome</SPAN>Depart</SPAN>1932</SPAN>
Belfast</SPAN>F</SPAN>eee</SPAN> Galway</SPAN>ee</SPAN>fff</SPAN> Bangkok</SPAN>e</SPAN>eee</SPAN>
Tom C.</SPAN>Arrive</SPAN>3291</SPAN>
Amsterdam</SPAN>f</SPAN>ggg</SPAN>
27</SPAN> 28</SPAN> 29</SPAN> 30</SPAN> 31</SPAN>
Jackie</SPAN>Depart</SPAN>2174</SPAN>
Singapore</SPAN>e</SPAN>eee</SPAN>
Maggie</SPAN>Depart</SPAN>2445</SPAN>
New York</SPAN>e</SPAN>eee</SPAN>
Jan-16</SPAN>
Sun</SPAN> Mon</SPAN> Tue</SPAN> Wed</SPAN> Thu</SPAN> Fri</SPAN> Sat</SPAN>
1</SPAN> 2</SPAN>
3</SPAN> 4</SPAN> 5</SPAN> 6</SPAN> 7</SPAN> 8</SPAN> 9</SPAN>
Jerome</SPAN>Arrive</SPAN>2636</SPAN> John H.</SPAN>Depart</SPAN>6933.4</SPAN> John H.</SPAN>Arrive</SPAN>9245</SPAN>John B.</SPAN>Depart</SPAN>
Bangkok</SPAN>F</SPAN>eee</SPAN> Dublin</SPAN>dg</SPAN>ggg</SPAN> Dublin</SPAN>ee</SPAN>fff</SPAN>Havana</SPAN>
Charllote</SPAN>Depart</SPAN>
Boston</SPAN>
10</SPAN> 11</SPAN> 12</SPAN> 13</SPAN> 14</SPAN> 15</SPAN> 16</SPAN>
Maggie</SPAN>Depart</SPAN>2777</SPAN> Charllote</SPAN>Arrive</SPAN>
New York</SPAN>e</SPAN>eee</SPAN> Boston</SPAN>
17</SPAN> 18</SPAN> 19</SPAN> 20</SPAN> 21</SPAN> 22</SPAN> 23</SPAN>
Maggie</SPAN>Arrive</SPAN>3702</SPAN> John B.</SPAN>Arrive</SPAN>3753</SPAN>
New York</SPAN>e</SPAN>eee</SPAN> Havana</SPAN>F</SPAN>eee</SPAN>
24</SPAN> 25</SPAN> 26</SPAN> 27</SPAN> 28</SPAN> 29</SPAN> 30</SPAN>
31</SPAN>

<TBODY>
</TBODY><COLGROUP><COL><COL span=2><COL><COL span=2><COL><COL span=2><COL><COL span=2><COL><COL span=3><COL span=2><COL><COL span=2></COLGROUP>


Many thanks in advance for your kind help, i really appreciate it.

Kind Regards,
Jas
 
Upvote 0
You must log in or register to reply here.

Similar threads

Mazbuka
  • Solved
opying into cells if particular criteria is met
Replies
3
Views
1K
Mazbuka
Mazbuka
M
  • Question
Find out how many different places are visited by each salesperson within a period (date range)
Replies
4
Views
458
alansidman
A
A
  • Solved
Data Validation
Replies
3
Views
724
DanteAmor
DanteAmor
R
  • Question
Finding difference in time
Replies
3
Views
489
etaf
etaf
A
  • Question
How to know the absent dates of Employees in one cell
Replies
0
Views
875
Azhar Abbas
A

Forum statistics

Threads
1,214,948
Messages
6,122,420
Members
449,083
Latest member
Ava19

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top