VBA - create a Loop to distribute dates along a year as per Maintenance frequency

L

Luthius

Active Member
Joined
Apr 5, 2011
Messages
324
Guys
I have the scenario below where I would like to create a loop to distribute along the columns (G column on) the date that that maintenance will ocurr based on its ID, Frequency and Due date. I will distribute it for a period of 01 year (365 days or 365 Columns)

For instance, the Maintenance for the ID 9960000192374 ocurrs every week and every month (Different maintenance , so my loop will fill an "x" the next due date to 08th Jan, and the next to 15th Jan, etc until reach the last week of a period of a year. After it, will go to the next row performing the next distribution.


The frequency varies, based on values of the frequency column.


[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Equipment[/TD]
[TD]Discipline[/TD]
[TD]Maintenance[/TD]
[TD]Frequency[/TD]
[TD]Due date[/TD]
[TD]01/Jan/18[/TD]
[TD]02/Jan/18[/TD]
[TD](...)[/TD]
[/TR]
[TR]
[TD]996000019374[/TD]
[TD]Equipment A[/TD]
[TD]Mechanical[/TD]
[TD]A[/TD]
[TD]1 Week[/TD]
[TD]01/01/2018[/TD]
[TD]X[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]996000019374[/TD]
[TD]Equipment A[/TD]
[TD]Instrumentation[/TD]
[TD]B[/TD]
[TD]1 Month[/TD]
[TD]01/01/2018[/TD]
[TD]X[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]996000019238[/TD]
[TD]Equipment C[/TD]
[TD]Electrical[/TD]
[TD]C[/TD]
[TD]3 Months[/TD]
[TD]01/01/2018[/TD]
[TD]X[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]











The original file contains more than 10k lines, the above table, is a short version of the problem.

Excel Columns reference based on above table:
ID= Column A
Due Date= Column F
(..) Means the others dates until 31st December

How can develop a loop that can distribute these dates?
 
Sort by date Sort by votes
Re: VBA - Help on create a Loop to distribute dates along a year as per Maintenance frequency

To Clarify:- Do you want the dates from ListOfEquipmentToGroup Places along the calendar in place of the previous "x's", and relating to "Equipment" name -Answer:Yes. The code will be sure that these equipment will be grouped when the first maintenance starts, the "x's" remain the same.

also, If the start date is later than the "1/1/18" the existing code will overrun the end of the year and possible Crash if there are no dates for the next year in row (1.
Do you want the Input from the code to always stay within a Calendar dates of 1 year i.e. 1/1/2018 to 31/12/2018 - Answer:If possible, when overruns the end of the year, the code can include the date on row 1 and the "X" on specific equipment row as was before.

By the way, amazing code you developed. IThank you in advance for what you did so far and time spent to assist me.
If you can make these change will be marvelous.
 
Last edited:
Upvote 0

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Re: VBA - Help on create a Loop to distribute dates along a year as per Maintenance frequency

Try this:-
ListOfEquipmentToGroup assumed to be on Sheet2 columns "A/B"
Code: 
[COLOR="Navy"]Sub[/COLOR] MG23Apr14
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Dt1 [COLOR="Navy"]As[/COLOR] Date, Dt [COLOR="Navy"]As[/COLOR] Date, col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] w [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] V [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range, eDt [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] nRng = .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] nRng
     .Item(Dn.Value) = Dn.Offset(, 1).Value
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
Rng.Offset(, 6).Resize(, 400).ClearContents
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    
    eDt = IIf(.exists(Dn.Offset(, 1).Value), .Item(Dn.Offset(, 1).Value), "x")
    [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Dn.Offset(, 4).Value
        [COLOR="Navy"]Case[/COLOR] "1 Week": V = "ww": n = 52
        [COLOR="Navy"]Case[/COLOR] "1 Month": V = "m": n = 12
        [COLOR="Navy"]Case[/COLOR] "3 Months": V = "q": n = 4
    [COLOR="Navy"]End[/COLOR] Select
    Dt1 = DateAdd(V, -1, Dn.Offset(, 5))
[COLOR="Navy"]For[/COLOR] w = 0 To n - 1
    Dt = DateAdd(V, w, Dn.Offset(, 5))
    col = Application.Match(CDbl(DateValue(Dt)), Range("G1").Resize(, 366), 0)
    Dn.Offset(, 5 + col) = eDt
[COLOR="Navy"]Next[/COLOR] w
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Re: VBA - Help on create a Loop to distribute dates along a year as per Maintenance frequency

Firstly I want to say thank you for your time and your code.

Unfortunately it is not working as I need.
I mean, the code are not properly grouping. Sorry, I guess I didnt explain it properly.

When I say "when the first maintenance starts", the code will get the earlier date from the equipment grouped and then start to distribute the frequency.

Lets say, Equipment A and Equipment C are listed on the other spreadsheet (Sheet2), but instead an "x" on Sheet2 I have on Column B the date they will start together, meaning that they are grouped because their maintenance will start together.
The code will read each equipment listed there with the same date (grouping them) , and then on the other spreadsheet will start to distribute the frequency based on the information your code was distributing before been the start date the date from the list of grouped equipment.

In other words, if the equipment is grouped (exists on Sheet2) the code will respect the date from Sheet2 to start the distribution. If doesn't exist on Sheet2, the code will respect the Due date mentioned before (Column F from the main Spreadsheet).

Thanks in advance
 
Upvote 0
Re: VBA - Help on create a Loop to distribute dates along a year as per Maintenance frequency

Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG24Apr36
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Dt1 [COLOR="Navy"]As[/COLOR] Date, dt [COLOR="Navy"]As[/COLOR] Date, Col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nDt [COLOR="Navy"]As[/COLOR] Date
[COLOR="Navy"]Dim[/COLOR] w [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] V [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range, eDt [COLOR="Navy"]As[/COLOR] Variant, Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
    [COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
        [COLOR="Navy"]Set[/COLOR] nRng = .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] nRng: Dic(Dn.Value) = Dn.Offset(, 1).Value: [COLOR="Navy"]Next[/COLOR]
    [COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
    Rng.Offset(, 6).Resize(, 400).ClearContents
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Dic.exists(Dn.Offset(, 1).Value) [COLOR="Navy"]Then[/COLOR]
                eDt = Dic(Dn.Offset(, 1).Value)
                nDt = Dic(Dn.Offset(, 1).Value)
            [COLOR="Navy"]Else[/COLOR]
                eDt = "x"
                nDt = Dn.Offset(, 5).Value
            [COLOR="Navy"]End[/COLOR] If
    
   [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Dn.Offset(, 4).Value
        [COLOR="Navy"]Case[/COLOR] "1 Week": V = "ww": n = 52
        [COLOR="Navy"]Case[/COLOR] "1 Month": V = "m": n = 12
        [COLOR="Navy"]Case[/COLOR] "3 Months": V = "q": n = 4
    [COLOR="Navy"]End[/COLOR] Select
    Dt1 = DateAdd(V, -1, Dn.Offset(, 5))
    [COLOR="Navy"]For[/COLOR] w = 0 To n - 1
            dt = DateAdd(V, w, nDt)
            Col = Application.Match(CDbl(DateValue(dt)), Range("G1").Resize(, 400), 0)
            Dn.Offset(, 5 + Col) = eDt
    [COLOR="Navy"]Next[/COLOR] w
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Re: VBA - Help on create a Loop to distribute dates along a year as per Maintenance frequency

Unfortunately its not working. It is not starting together as per start Date or Grouping.
I put both tables.


Main Spreadsheet (Sheet1)
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Equipment[/TD]
[TD]Discipline[/TD]
[TD]Maintenance[/TD]
[TD]Frequency[/TD]
[TD]Due date[/TD]
[TD]01/Jan/18[/TD]
[/TR]
[TR]
[TD]996000019374[/TD]
[TD]Equipment A[/TD]
[TD]Mechanical[/TD]
[TD]A[/TD]
[TD]1 Week[/TD]
[TD]01/01/2018[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]996000019374[/TD]
[TD]Equipment A[/TD]
[TD]Instrumentation[/TD]
[TD]B[/TD]
[TD]1 Month[/TD]
[TD]01/Jan/2018[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]996000019238[/TD]
[TD]Equipment C[/TD]
[TD]Electrical[/TD]
[TD]C[/TD]
[TD]3 Months[/TD]
[TD]01/Jan/2018[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]996000019238[/TD]
[TD]Equipment B[/TD]
[TD]Electrical[/TD]
[TD]C[/TD]
[TD]1 Month[/TD]
[TD]13/Jan/2018[/TD]
[TD][/TD]
[/TR]
[TR]
[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]
[/TR]
</tbody>[/TABLE]
















Grouped Equipment (Sheet2)
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Equipment[/TD]
[TD]Starts On[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Equipment A[/TD]
[TD]01/April/2018[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Equipment B[/TD]
[TD]01/April/2018[/TD]
[TD][/TD]
[/TR]
[TR]
[TD](...)[/TD]
[TD](...)[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]








Equipment A and Equipment B are grouped (they exist on Sheet2) and must start together on April 1st.
When distributing the dates, this will be starting point for these 02 equipment.

The equipment C is not grouped (it doesnt exist on Sheet2), so the code will distribute the frequency based on Due date of the Main Spreadsheet (Sheet1).

Seems that the code is not respecting the dates from Sheet2.
 
Last edited:
Upvote 0
Re: VBA - Help on create a Loop to distribute dates along a year as per Maintenance frequency

It works for me if you increase the dates in row 1 into 2019
See reference to this in post 8 & 10.
This is the first 2 Listing with values in calendar:-
[TABLE="width: 172"]
<tbody>[TR]
[TD="class: xl65, width: 97, bgcolor: white"]01-Jan-18
[/TD]
[TD="width: 35, bgcolor: transparent"][/TD]
[TD="class: xl65, width: 97, bgcolor: white"]01-Apr-18
[/TD]
[/TR]
[TR]
[TD="class: xl66, width: 97, bgcolor: white"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="class: xl66, width: 97, bgcolor: white"]01/04/2018
[/TD]
[/TR]
[TR]
[TD="class: xl66, width: 97, bgcolor: white"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="class: xl66, width: 97, bgcolor: white"]01/04/2018
[/TD]
[/TR]
[TR]
[TD="class: xl66, width: 97, bgcolor: white"]x
[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="class: xl66, width: 97, bgcolor: white"]x
[/TD]
[/TR]
[TR]
[TD="class: xl66, width: 97, bgcolor: white"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="class: xl66, width: 97, bgcolor: white"]01/04/2018
[/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Upvote 0
Re: VBA - Help on create a Loop to distribute dates along a year as per Maintenance frequency

If you intend to increase the Calendar range into 2019 then you will need to increase the range (number of columns ) in the line below to match the number of dates:-

Code: 
Col = Application.Match(CDbl(DateValue(dt)), Range("G1").Resize(, [B][COLOR=#FF0000]400[/COLOR][/B]), 0)
 
Upvote 0
Re: VBA - Help on create a Loop to distribute dates along a year as per Maintenance frequency

Thank you very much.
Testing and seems that it is working so far.
I will test with real values and I will give the feedback afterwards.
 
Last edited:
Upvote 0
Re: VBA - Help on create a Loop to distribute dates along a year as per Maintenance frequency

Is there possibility to put in column date a value from the column 4 from the main spreadsheet? This will inform the type of maintenance that will occur on that date.

Instead of "X" or the date, will be a value from Column 4 from the main spreadsheet.
Everything is perfect. Just this additional feature if possible.
 
Upvote 0
Re: VBA - Help on create a Loop to distribute dates along a year as per Maintenance frequency

Try this:-
Alter code where shown in Red:-
Code: 
If Dic.exists(Dn.Offset(, 1).Value) Then
                eDt = [B][COLOR=#ff0000]Dn.Offset(, 3).Value       [/COLOR][/B]'Was :-Dic(Dn.Offset(, 1).Value)
                nDt = Dic(Dn.Offset(, 1).Value)
            Else
                eDt = Dn[B][COLOR=#ff0000].Offset(, 3).Value         [/COLOR][/B]'Was :- "x"
                nDt = Dn.Offset(, 5).Value
            End If
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question Question
Cashflow forecast based on start dates and either monthly, bi-monthly, quarterly, annually
Replies
2
Views
792
felixstraube
F
L
  • Solved
VBA Find Cell from Date listed, in Columns, Return cell to highlight in color
Replies
7
Views
532
mumps
mumps
MrDB4Excel
  • Question Question
Populate Date to Another Workbook
Replies
7
Views
169
MrDB4Excel
MrDB4Excel
D
  • Question Question
VBA that distributes dates along the year based on a schedule
Replies
1
Views
821
XLfriend777
XLfriend777
L
  • Question Question
VBA works on work PC but not home PC
Replies
3
Views
2K
rollis13
rollis13

Forum statistics

Threads
1,224,823
Messages
6,181,184
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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