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

Luthius · Apr 12, 2018

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.

ID	Equipment	Discipline	Maintenance	Frequency	Due date	01/Jan/18	02/Jan/18	(...)
996000019374	Equipment A	Mechanical	A	1 Week	01/01/2018	X
996000019374	Equipment A	Instrumentation	B	1 Month	01/01/2018	X
996000019238	Equipment C	Electrical	C	3 Months	01/01/2018	X

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?

Luthius · Apr 23, 2018

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.

MickG · Apr 23, 2018

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

Luthius · Apr 23, 2018

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

MickG · Apr 24, 2018

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

Luthius · Apr 24, 2018

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)

ID	Equipment	Discipline	Maintenance	Frequency	Due date	01/Jan/18
996000019374	Equipment A	Mechanical	A	1 Week	01/01/2018
996000019374	Equipment A	Instrumentation	B	1 Month	01/Jan/2018
996000019238	Equipment C	Electrical	C	3 Months	01/Jan/2018
996000019238	Equipment B	Electrical	C	1 Month	13/Jan/2018

Grouped Equipment (Sheet2)

Equipment	Starts On
Equipment A	01/April/2018
Equipment B	01/April/2018
(...)	(...)

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.

MickG · Apr 24, 2018

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:-

01-Jan-18		01-Apr-18
		01/04/2018
		01/04/2018
x		x
		01/04/2018

MickG · Apr 24, 2018

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)

Luthius · Apr 24, 2018

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.

Luthius · Apr 24, 2018

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.

MickG · Apr 24, 2018

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

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

Luthius

Active Member

Luthius

Active Member

Excel Facts

MickG

MrExcel MVP

Luthius

Active Member

MickG

MrExcel MVP

Luthius

Active Member

MickG

MrExcel MVP

MickG

MrExcel MVP

Luthius

Active Member

Luthius

Active Member

MickG

MrExcel MVP

Similar threads

Forum statistics

Share this page

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

Active Member

Active Member

Excel Facts

MrExcel MVP

Active Member

MrExcel MVP

Active Member

MrExcel MVP

MrExcel MVP

Active Member

Active Member

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock