VBA: Macro to Spread value across columns

chuffles

New Member
Joined
Oct 3, 2021
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
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.


1634191124333.png
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
51,845
Office Version
  1. 365
Platform
  1. Windows
Does it have to be a macro? Would a formula like this do? (Ranges may need adjusting)

21 10 14.xlsm
WXYAMANAOAPAQARASATAUAV
22SKIP
3127/02/20216/03/202113/03/202120/03/202127/03/20213/04/202110/04/202117/04/202124/04/20211/05/2021
32
3310000053/03/2021 200002000020000 2000020000   
Spread
Cell Formulas
RangeFormula
AM33:AV33AM33=IF(AND(AM$31>=$Y33,COUNTIF($AM$31:AM$31,">="&$Y33)<=$X33+COUNTA($AM$22:AM$22),AM22=""),$W33/$X33,"")
 

chuffles

New Member
Joined
Oct 3, 2021
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
51,845
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
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
WXYAMANAOAPAQARASATAUAVAWAX
22SKIPSKIPSKIP
23
30
3127/02/20216/03/202113/03/202120/03/202127/03/20213/04/202110/04/202117/04/202124/04/20211/05/20218/05/202115/05/2021
32
3310000053/03/20212000020000200002000020000
34
3550000613/03/20218333.3333338333.3333338333.333338333.3333338333.333338333.33333
Spread (3)
 

chuffles

New Member
Joined
Oct 3, 2021
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
51,845
Office Version
  1. 365
Platform
  1. Windows
Perhaps we only need to check X instead of W?
Rich (BB code):
.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
VBA Code:
.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,""""))"
 

Forum statistics

Threads
1,148,244
Messages
5,745,596
Members
423,964
Latest member
Rayds

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
Top