VBA: Macro to Spread value across columns

[chuffles]

Hi all,

I'm trying to write a macro that does the following:

Takes the Value in #1, Divides it by number of weeks (#2) and Spreads it based on the Starting Date, rounded up to the nearest Sunday.

So in the example below, I need to insert the value $100 000/20 = $5000 into the 20 cells starting after 2021-03-06 (the nearest Sunday).
The complication is that I must skip any columns that say "SKIP" (Column AQ)

Can anyone assist? It would be much appreciated, and I would be more than happy to ubereats you some food.

 

[Peter_SSs]

Does it have to be a macro? Would a formula like this do? (Ranges may need adjusting)

21 10 14.xlsm
	W	X	Y														AM	AN	AO	AP	AQ	AR	AS	AT	AU	AV
22																					SKIP
31																	27/02/2021	6/03/2021	13/03/2021	20/03/2021	27/03/2021	3/04/2021	10/04/2021	17/04/2021	24/04/2021	1/05/2021
32
33	100000	5	3/03/2021															20000	20000	20000		20000	20000
Spread

Cell Formulas
Range	Formula
AM33:AV33	AM33	=IF(AND(AM$31>=$Y33,COUNTIF($AM$31:AM$31,">="&$Y33)<=$X33+COUNTA($AM$22:AM$22),AM22=""),$W33/$X33,"")

 

[chuffles]

Hi Peter,

Thank you for the response - unfortunately it does need to be a macro as I'm unable to retain formulas in those cells due to business requirements.

 

[Peter_SSs]

I'm unable to retain formulas in those cells

That sounds like it would be okay to put formulas in there and then replace the formulas with their results"
If so, see if this is headed in the right direction. Test with a copy of your workbook.

Sub Spread()
  Dim lr As Long, lc As Long
 
  lr = Cells(Rows.Count, "W").End(xlUp).Row
  lc = Cells(31, Columns.Count).End(xlToLeft).Column
  With Range("AM33", Cells(lr, lc))
    .Formula = "=IF($W33="""","""",IF(AND(AM$31>=$Y33,COUNTIF($AM$31:AM$31,"">=""&$Y33)<=$X33+COUNTA($AM$22:AM$22),AM$22=""""),$W33/$X33,""""))"
    .Value = .Value
  End With
End Sub

Here is a section of my test data and results

chuffles.xlsm
	W	X	Y														AM	AN	AO	AP	AQ	AR	AS	AT	AU	AV	AW	AX
22																					SKIP			SKIP	SKIP
23
30
31																	27/02/2021	6/03/2021	13/03/2021	20/03/2021	27/03/2021	3/04/2021	10/04/2021	17/04/2021	24/04/2021	1/05/2021	8/05/2021	15/05/2021
32
33	100000	5	3/03/2021															20000	20000	20000		20000	20000
34
35	50000	6	13/03/2021																8333.333333	8333.333333		8333.33333	8333.333333			8333.33333	8333.33333
Spread (3)

 

[chuffles]

Hi Peter,

Thank you so much, we're very close now. Currently the macro is inserting DIV errors when X is blank (trying to divide by 0), so I think I will need to revise the macro to only run if column X and Y are not blank.

 

[Peter_SSs]

Perhaps we only need to check X instead of W?

.Formula = "=IF($X33="""","""",IF(AND(AM$31>=$Y33,COUNTIF($AM$31:AM$31,"">=""&$Y33)<=$X33+COUNTA($AM$22:AM$22),AM$22=""""),$W33/$X33,""""))"

But if it needs to check both, that is you could also have a number in X but not W, then try

.Formula = "=IF(OR($W33="""",$X33=""""),"""",IF(AND(AM$31>=$Y33,COUNTIF($AM$31:AM$31,"">=""&$Y33)<=$X33+COUNTA($AM$22:AM$22),AM$22=""""),$W33/$X33,""""))"