Vba allocation inquiry

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

Answer

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