Hi,

Using Excel 2010 and fairly experienced using macros

Looking for some help in splitting monthly forecast into weekly buckets, data could be horizontal or vertical (most cases it will be horizontal)

2nd Mar 2015 6th April 2015 4th May 2015 etc.
120 120 240 etc.

Ideal result would be

2nd March 9th March 16th March 23rd March 30th March etc.
20 20 20 20 20 etc.

On occasion there may be a customer who prefers it to be monthly and the forecast received would be in quarterly buckets.

Any help will be greatly appreciated

Thanks
Raymond

hi Raymond,

the dates in A1:C1 must be true dates
the result is put in cells A3:C10

Sub Macro1()
Dim i As Long, y As Integer, x As Integer
For i = 1 To 3 'range A1, B1, C1
For y = 1 To 8 Step 2 '4 weeks max per month
If Cells(y, i) + 7 < Cells(1, i + 1) Then
Cells(y + 2, i) = Cells(y, i) + 7
If Cells(1, i + 1) = 0 Then
Cells(y + 3, i) = Cells(2, i) / 4
Else
x = (((Cells(1, i + 1) - Cells(1, i)) / 7)) - 1
Cells(y + 3, i) = Cells(2, i) / x
End If
Else
Exit For
End If
Next
Next
End Sub

isabelle

Le 2015-03-02 11:41, Raymond Allan a écrit :
Hi,

Using Excel 2010 and fairly experienced using macros

Looking for some help in splitting monthly forecast into weekly buckets, data could be horizontal or vertical (most cases it will be horizontal)

2nd Mar 2015 6th April 2015 4th May 2015 etc.
120 120 240 etc.

Ideal result would be

2nd March 9th March 16th March 23rd March 30th March etc.
20 20 20 20 20 etc.

On occasion there may be a customer who prefers it to be monthly and the forecast received would be in quarterly buckets.

Any help will be greatly appreciated

Thanks
Raymond

oops, i forgot the first date
the result is put in cells A3:C12

Sub Macro1()
Dim i As Long, y As Integer, x As Integer
For i = 1 To 3 'range A1, B1, C1
For y = 1 To 10 Step 2 '5 weeks max per month
If Cells(1, i) + (7 * a) < Cells(1, i + 1) Then
Cells(y + 2, i) = Cells(1, i) + (7 * a)
a = a + 1
If Cells(1, i + 1) = 0 Then
Cells(y + 3, i) = Cells(2, i) / 5
Else
x = (((Cells(1, i + 1) - Cells(1, i)) / 7))
Cells(y + 3, i) = Cells(2, i) / x
End If
Else
Exit For
End If
Next
a = 0
Next
End Sub


isabelle

Hi Raymond,

Am Mon, 2 Mar 2015 08:41:10 -0800 (PST) schrieb Raymond Allan:

2nd Mar 2015 6th April 2015 4th May 2015 etc.
120 120 240 etc.

Ideal result would be

2nd March 9th March 16th March 23rd March 30th March etc.
20 20 20 20 20 etc.

your data in rows 1 and 2. In row 1 are true dates
Then in A5:
=A1
In B5:
=IF(A5+7<=MAX(1:1),A5+7,"")
and copy to the right till cell remains empty
In A6:
=IFERROR(7*INDEX(2:2,MATCH(MONTH(A5),MONTH($A$1:$Z $1),0))/(INDEX(1:1,MATCH(MONTH(A5)+1,MONTH($A$1:$Z$1),0))-INDEX(1:1,MATCH(MONTH(A5),MONTH($A$1:$Z$1),0))),LO OKUP(2,1/(2:2),2:2))
Insert this formula with CTRL+Shift+Enter and copy to the right


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Thanks for both solutions, they have really helped.

Hi Claus,

Your solution works well up until the 3rd August where it then puts the full value of 102 into the weekly buckets, it corrects itself on the 5th October then goes back to the full value from the 2nd Nov until the last date

Row 1 has the dates and row 2 has the values (some months can be zero)

A1 02/03/2015 102
B1 06/04/2015 102
C1 04/05/2015 102
D1 01/06/2015
E1 06/07/2015 102
F1 03/08/2015 102
G1 31/08/2015
H1 05/10/2015 102
I1 02/11/2015
J1 30/11/2015 102
K1 04/01/2016 102

Partial output (which is horizontal and what I expected to see)

02/03/2015 = 20.4
09/03/2015 = 20.4
16/03/2015 = 20.4
23/03/2015 = 20.4
30/03/2015 = 20.4

Would appreciate you having another look at your formula...

Hi Raymond,

Am Tue, 3 Mar 2015 01:35:08 -0800 (PST) schrieb Raymond Allan:

Would appreciate you having another look at your formula...

in A5:
=A1
In B5:
=IF(A5+7<=MAX(1:1),A5+7,"")
and copy to the right
In A6:
=IFERROR(7*INDEX(2:2,MATCH(YEAR(A5)&MONTH(A5),YEAR ($A$1:$Z$1)&MONTH($A$1:$Z$1),0))/(IF(INDEX(1:1,MATCH(YEAR(A5)&MONTH(A5),YEAR($A$1:$ Z$1)&MONTH($A$1:$Z$1),0)+1)=0,28,INDEX(1:1,MATCH(Y EAR(A5)&MONTH(A5),YEAR($A$1:$Z$1)&MONTH($A$1:$Z$1) ,0)+1)-INDEX(1:1,MATCH(YEAR(A5)&MONTH(A5),YEAR($A$1:$Z$1) &MONTH($A$1:$Z$1),0)))),"")


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Thanks Claus, unfortunately it only calculates correctly up to the 30th Nov date, data is correct for 2nd Nov to 30th Nov, the next batch should be 30th Nov 2015 to Jan 4th 2016, there is zero for the 7th, 14th, 21st & 28th Dec but a quantity of 25 for the 4th Jan ?

Hi Isabelle,

Thanks for the new code, on the 3rd month it is producing a result for 5 weeks instead of 4

When I add another date and quantity, 1st June and a qty of 102, I see the 1st of June date on the 3rd month and on the 4th month

Hope the above makes sense to you

Raymond

Hi Isabelle,

Ignore my last message, your code produces the desired result, is it possible the results could be seen horizontally rather than vertical.

Dependent on the forecast received and the output required I will be using a combination of your code and Claus's formula

Raymond

hi Raymond,

yes, here's the horizontal version

Sub Horizontal_List()
Dim i As Long, y As Integer, x As Integer, a As Integer, clmn As Integer
clmn = 1
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column 'range A1, B1, C1 etc
For y = 1 To 5 '5 weeks max per month
If Cells(1, i) + (7 * a) < Cells(1, i + 1) Then
Cells(3, clmn) = Cells(1, i) + (7 * a)
a = a + 1
If Cells(1, i + 1) = 0 Then
Cells(4, clmn) = Cells(2, i) / 5
Else
x = (((Cells(1, i + 1) - Cells(1, i)) / 7))
Cells(4, clmn) = Cells(2, i) / x
End If
Else
Exit For
End If
clmn = clmn + 1
Next
a = 0
Next
End Sub

isabelle

Le 2015-03-03 05:14, Raymond Allan a écrit :
Hi Isabelle,

Ignore my last message, your code produces the desired result, is it possible the results could be seen horizontally rather than vertical.

Dependent on the forecast received and the output required I will be using a combination of your code and Claus's formula

Raymond

Perfect Isabelle, thank you so much

a shorter version, i removed a variable

Sub Horizontal_List2()
Dim i As Long, y As Integer, x As Integer, clmn As Integer
clmn = 1
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column 'range A1, B1, C1 etc
For y = 0 To 4 '5 weeks max per month
If Cells(1, i) + (7 * y) < Cells(1, i + 1) Then
Cells(3, clmn) = Cells(1, i) + (7 * y)
If Cells(1, i + 1) = 0 Then
Cells(4, clmn) = Cells(2, i) / 5
Else
x = (((Cells(1, i + 1) - Cells(1, i)) / 7))
Cells(4, clmn) = Cells(2, i) / x
End If
Else
Exit For
End If
clmn = clmn + 1
Next
Next
End Sub

isabelle

Le 2015-03-03 09:47, Raymond Allan a écrit :
Perfect Isabelle, thank you so much