# Vba allocation inquiry

Last Edited By Krjb Donovan
Last Updated: Mar 05, 2014 10:01 PM GMT

## Question QUESTION: I used part of the code of one of your examples to build an allocation macro. The problem I got is when the columns with the Skus are more than 100 the macro can run because it's too long. How can I reduce the macro and have the allocation of the orders? Make the macro more efficient? Thanking before having your kind response.

Sub Allocation() 'abcd and efgh 1'

For Each abcd In Range("D6:D4402")

```    If abcd = 1 Then abcd.Offset(0, 0).FormulaR1C1 = "=RC[-1]" Else abcd.Offset(0, 0) = 0
If abcd > Range("D5").Value Then abcd.Offset(0, 0).FormulaR1C1 = Range("D5")
Set efgh = Range("D5")
efgh.Offset(0, 0).FormulaR1C1 = efgh - abcd

Next
'abdc and efhg 2'

For Each abdc In Range("E6:E4402")
If abdc = 1 Then abdc.Offset(0, 0).FormulaR1C1 = "=RC[-2]" Else abdc.Offset(0, 0) = 0
If abdc > Range("E5").Value Then abdc.Offset(0, 0).FormulaR1C1 = Range("E5")
Set efhg = Range("E5")
efhg.Offset(0, 0).FormulaR1C1 = efhg - abdc

Next
'acbd and egfh 3'

For Each d In Range("G6:G4402")
If d = 1 Then d.Offset(0, 0).FormulaR1C1 = "=RC[-4]" Else d.Offset(0, 0) = 0
If d > Range("G5").Value Then d.Offset(0, 0).FormulaR1C1 = Range("G5")
Set x = Range("G5")
x.Offset(0, 0).FormulaR1C1 = x - d
Next
```

End Sub

Example of thefile:

1 2 3 4 5 6 7 8 AB.0027 AB.0028 AB.0029 BMAR.0001 BMAR.0002 BMAR.0003 BMAR.0004 BMAR.0005 153 257 0 2850 3320 1320 1170 2940 1 1 1 1 1 1 1 1 ORDNO PRDNO Total 151 253 0 2650 2850 1320 1170 2940 170550 BMAR.0005 20 0 0 0 0 0 0 0 1 KNW.0500 12 0 0 0 0 0 0 0 0 170563 MAR.0020 20 0 0 0 0 0 0 0 0 MAR.0022 20 0 0 0 0 0 0 0 0 171192 KP.0166 3 0 0 0 0 0 0 0 0 MAR.0006 10 0 0 0 0 0 0 0 0 MAR.0011 10 0 0 0 0 0 0 0 0 MAR.0020 10 0 0 0 0 0 0 0 0 171204 KOB.0258 5 0 0 0 0 0 0 0 0 KOB.0260 5 0 0 0 0 0 0 0 0 KOB.0261 5 0 0 0 0 0 0 0 0 KOB.0800 5 0 0 0 0 0 0 0 0 KOB.0817 5 0 0 0 0 0 0 0 0

ANSWER: If I understand what you're trying to do, then this macro will handle ALL your columns -- no need for a long macro!

Sub Allocation() 'all For COL=4 to Range("IV6").end(xltoLeft).Column

``` For Each abcd In Range("D6:D4402").Offset(,COL-4)
If abcd = 1 Then abcd.FormulaR1C1 = "=RC3" Else abcd = 0
If abcd > Range("D5").Offset(0,COL-4).Value Then abcd.FormulaR1C1 = Range("D5").Offset(0,COL-4).Value
Set efgh = Range("D5").Offset(0,COL-4).Value
efgh.FormulaR1C1 = efgh - abcd
Next
```

Next End Sub

---------- FOLLOW-UP ----------

QUESTION: Thank you so much for your answer. What I'm trying to do is:

1. allocate the value that is in column C in every of the 876 columns (from D to AGU). If any of this columns has a 1 and the value to allocate is equal or less than what's in D3....GU3.

2. Every column has a different value in position 3. That's the value that I need to use to compare as per before. So the Macro has to read every column and allocate the value.

I tried the macro you sent me but I didn't work for what I explain before. I attached the image of thesheet so that you can see what I'm trying to explain to you.

I appreciate your help and I

Best

Sorry - one error in my macro. Try this: Sub Allocation() 'all

```   For COL = 4 To Range("IV6").End(xlToLeft).Column
For Each abcd In Range("D6:D44").Offset(, COL - 4)
If abcd = 1 Then abcd.FormulaR1C1 = "=RC3" Else abcd = 0
If abcd > Range("D5").Offset(0, COL - 4).Value Then abcd.FormulaR1C1 = Range("D5").Offset(0, COL - 4).Value
Set efgh = Range("D5").Offset(0, COL - 4)
efgh.FormulaR1C1 = efgh - abcd
Next
Next
```

End Sub