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:
[TABLE="width: 1237"]
<TBODY>[TR]
[TD="align: right"]01/12/2015</SPAN>[/TD]
[TD][/TD]
[TD="align: right"]04/12/2015</SPAN>[/TD]
[TD][/TD]
[TD="align: right"]05/12/2015</SPAN>[/TD]
[TD][/TD]
[TD="align: right"]11/12/2015</SPAN>[/TD]
[TD][/TD]
[TD="align: right"]13/12/2015</SPAN>[/TD]
[TD][/TD]
[TD="align: right"]14/12/2015</SPAN>[/TD]
[TD][/TD]
[TD="align: right"]17/12/2015</SPAN>[/TD]
[TD][/TD]
[TD="colspan: 2"]20/12/015</SPAN>[/TD]
[TD="align: right"]23/12/2015</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]John H.</SPAN>[/TD]
[TD]Depart</SPAN>[/TD]
[TD]Steve </SPAN>[/TD]
[TD]Depart</SPAN>[/TD]
[TD]John H.</SPAN>[/TD]
[TD]Arrive</SPAN>[/TD]
[TD]John H. </SPAN>[/TD]
[TD]Depart</SPAN>[/TD]
[TD]John H.</SPAN>[/TD]
[TD]Arrive</SPAN>[/TD]
[TD]Steve</SPAN>[/TD]
[TD]Arrive</SPAN>[/TD]
[TD]Steve </SPAN>[/TD]
[TD]Depart</SPAN>[/TD]
[TD]John H.</SPAN>[/TD]
[TD]Depart</SPAN>[/TD]
[TD]John H.</SPAN>[/TD]
[TD]Arrive</SPAN>[/TD]
[/TR]
[TR]
[TD]London </SPAN>[/TD]
[TD] [/TD]
[TD]Dublin</SPAN>[/TD]
[TD] [/TD]
[TD] London[/TD]
[TD] [/TD]
[TD]Edinburgh</SPAN>[/TD]
[TD] [/TD]
[TD]Edinburgh</SPAN>[/TD]
[TD] [/TD]
[TD]Dublin</SPAN>[/TD]
[TD] [/TD]
[TD]Belfast</SPAN>[/TD]
[TD] [/TD]
[TD]Galway</SPAN>[/TD]
[TD] [/TD]
[TD]Galway</SPAN>[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Tom C.</SPAN>[/TD]
[TD]Depart</SPAN>[/TD]
[TD]Tom C.</SPAN>[/TD]
[TD]Arrive</SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[TD]Tom C.</SPAN>[/TD]
[TD]Depart</SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[TD]Tom C.</SPAN>[/TD]
[TD]Arrive</SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[TD]Steve</SPAN>[/TD]
[TD]Arrive</SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Cork</SPAN>[/TD]
[TD] [/TD]
[TD]Cork</SPAN>[/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"]Amsterdam</SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"]Amsterdam</SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[TD]Belfast</SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</TBODY><COLGROUP><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL span=3><COL><COL></COLGROUP>[/TABLE]







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.


[TABLE="width: 896"]
<TBODY>[TR]
[TD]Dec 2015</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Sun</SPAN>[/TD]
[TD] [/TD]
[TD]Mon</SPAN>[/TD]
[TD] [/TD]
[TD]Tue</SPAN>[/TD]
[TD] [/TD]
[TD]Wed</SPAN>[/TD]
[TD] [/TD]
[TD]Thurs</SPAN>[/TD]
[TD] [/TD]
[TD]Fri</SPAN>[/TD]
[TD] [/TD]
[TD]Sat</SPAN>[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]1</SPAN>[/TD]
[TD] [/TD]
[TD]2</SPAN>[/TD]
[TD] [/TD]
[TD]3</SPAN>[/TD]
[TD] [/TD]
[TD]4</SPAN>[/TD]
[TD] [/TD]
[TD]5</SPAN>[/TD]
[TD] [/TD]
[TD]6</SPAN>[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]John H.</SPAN>[/TD]
[TD]Depart</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]John H.</SPAN>[/TD]
[TD]Arrive</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]London </SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] London[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]Tom C.</SPAN>[/TD]
[TD]Depart</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Tom C.</SPAN>[/TD]
[TD]Arrive</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]Cork</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Cork</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Steve </SPAN>[/TD]
[TD]Depart</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Dublin</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]7</SPAN>[/TD]
[TD] [/TD]
[TD]8</SPAN>[/TD]
[TD] [/TD]
[TD]9</SPAN>[/TD]
[TD] [/TD]
[TD]10</SPAN>[/TD]
[TD] [/TD]
[TD]11</SPAN>[/TD]
[TD] [/TD]
[TD]12</SPAN>[/TD]
[TD] [/TD]
[TD]13</SPAN>[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]John H.</SPAN>[/TD]
[TD]Depart</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD]John H.</SPAN>[/TD]
[TD]Arrive</SPAN>[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD="colspan: 2"]Edinburgh</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="colspan: 2"]Edinburgh</SPAN>[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Tom C.</SPAN>[/TD]
[TD]Depart</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD="colspan: 2"]Amsterdam</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]14</SPAN>[/TD]
[TD] [/TD]
[TD]15</SPAN>[/TD]
[TD] [/TD]
[TD]16</SPAN>[/TD]
[TD] [/TD]
[TD]17</SPAN>[/TD]
[TD] [/TD]
[TD]18</SPAN>[/TD]
[TD] [/TD]
[TD]19</SPAN>[/TD]
[TD] [/TD]
[TD]20</SPAN>[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Steve </SPAN>[/TD]
[TD]Depart</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Steve </SPAN>[/TD]
[TD]Arrive</SPAN>[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Belfast</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Belfast</SPAN>[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] Tom C.[/TD]
[TD]Arrive [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]John H.</SPAN>[/TD]
[TD]Depart</SPAN>[/TD]
[/TR]
[TR]
[TD] Amsterdam[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Galway</SPAN>[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Steve </SPAN>[/TD]
[TD]Arrive</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Dublin</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]21</SPAN>[/TD]
[TD] [/TD]
[TD]22</SPAN>[/TD]
[TD] [/TD]
[TD]23</SPAN>[/TD]
[TD] [/TD]
[TD]24</SPAN>[/TD]
[TD] [/TD]
[TD]25</SPAN>[/TD]
[TD] [/TD]
[TD]26</SPAN>[/TD]
[TD] [/TD]
[TD]27</SPAN>[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]John H.</SPAN>[/TD]
[TD]Arrive</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Galway</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]28</SPAN>[/TD]
[TD] [/TD]
[TD]29</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
</TBODY><COLGROUP><COL span=14></COLGROUP>[/TABLE]

Many thanks in advance for your kind help.
Kind Regards,
Jas
 
Sort by date Sort by votes
Try this for your latest data, Results sheet 2
Code: 
[COLOR=Navy]Sub[/COLOR] MG09Nov48
[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] mD [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer,[/COLOR] cD [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/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 21)
            Ray(1, 1) = Format(Fdt, "mmm-yyyy")
[COLOR=Navy]For[/COLOR] mDay = 1 To 7
   mD = 1 + (3 * (mDay - 1))
   Ray(2, mD) = WeekdayName(mDay, False, 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))
     cD = 1 + (3 * (Col - 1))
      Ray(Rw, cD) = 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, Ac + 1) = R.Offset(1, 1)
            Ray(Rw + c, Ac + 2) = R.Offset(1, 2)
            Ray(Rw + c + 1, Ac) = R.Offset(2)
            Ray(Rw + c + 1, Ac + 1) = R.Offset(2, 1)
            Ray(Rw + c + 1, Ac + 2) = R.Offset(2, 2)
            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, 21)
   .Value = Ray
    .ColumnWidth = 10 '[COLOR=Green][B]AutoFit[/B][/COLOR]
    .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 = "Sunday" [COLOR=Navy]Then[/COLOR]
        c = 0
        Dn.Resize(, 21).Interior.Color = vbGreen
    [COLOR=Navy]Else[/COLOR]
        [COLOR=Navy]If[/COLOR] c = 0 Or c Mod 7 = 0 [COLOR=Navy]Then[/COLOR]
            Dn.Resize(, 21).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,

When i play with the data (copy paste-ing the date from the other source), the macro always stop on this part (Ray(Rw, Col + Col - 1) = mDay):


For 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)
If mDay = mMax Then Exit For
Next mDay


Could you please advise if it required specific date format?

Kind Regards,
Jas
 
Upvote 0
Can you send the data the code fails on !!!!
NB:- Also, are you aware the Piece of code you have sent is from the First Code not the latest ????
 
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 Question
Find out how many different places are visited by each salesperson within a period (date range)
Replies
4
Views
627
alansidman
alansidman
A
  • Solved
Data Validation
Replies
3
Views
848
DanteAmor
DanteAmor
R
  • Question Question
Finding difference in time
Replies
3
Views
573
etaf
etaf
A
  • Question Question
How to know the absent dates of Employees in one cell
Replies
0
Views
984
Azhar Abbas
A

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