# Excel VBA building 2d array 1 col at a time in separate for loops OR multiplying a 1d array x another 1d array

#### JosephTL

##### New Member
Good day, 'TLDR below, this is just for context
This question does not necessarily need to be answered as long as there is a solution to my problem one way or another.
-----------------Background of what I'm attempting to accomplish.-------------------------------
I'm building a usage model where I take several hundred jobs (400-600), compare their active dates Vs the dates throughout the year, and multiply the amount of equipment they use (~2600 unique pcs) vs 1 of 6 percent charts.
I already built this IN an excel formula which works pretty well... Issue is I had to break up each month to a single spreadsheet, the year file into another, and import the values torun my capital expense projections//usage shortages. Each month sheet(~30-40mb) takes my computer 2 minutes to open and 2 minutes to save/close, so whenever I want to make an adjustment it takes about 30+minutes and a re-import. See formula below(or skip not that important)(it is just a nightmare that took me like a week to get right).

=IFERROR(ROUNDUP(IF(OR([@Category]="GRD",[@Category]="STR"),IF(OR(VLOOKUP(G\$1 & "*",AllJobs,5,0)>Apr_1,VLOOKUP(G\$1 & "*",AllJobs,9,0)<Apr_1),0,IF(AND(VLOOKUP(G\$1 & "*",AllJobs,6,0)<=Apr_1,VLOOKUP(G\$1 & "*",AllJobs,8,0)>Apr_1),AprProjection!G3,IF(AND(VLOOKUP(G\$1 & "*",AllJobs,5,0)<=Apr_1,VLOOKUP(G\$1 & "*",AllJobs,6,0)>=Apr_1),AprProjection!G3*@INDEX(Picket_Steps[[1]:[18]],ROUNDUP((Apr_1-VLOOKUP(G\$1 & "*",AllJobs,5,0))/7,0),VLOOKUP(G\$1 & "*",AllJobs,24,0)),AprProjection!G3*@INDEX(Picket_Steps_Strike[[1]:[18]],ROUNDUP((Apr_1-VLOOKUP(G\$1 & "*",AllJobs,8,0))/7,0),VLOOKUP(G\$1 & "*",AllJobs,26,0))))),IF([@Category]="ACC",IF(OR(VLOOKUP(G\$1 & "*",AllJobs,5,0)>Apr_1,VLOOKUP(G\$1 & "*",AllJobs,9,0)<Apr_1),0,IF(AND(VLOOKUP(G\$1 & "*",AllJobs,6,0)<=Apr_1,VLOOKUP(G\$1 & "*",AllJobs,8,0)>Apr_1),AprProjection!G3,IF(AND(VLOOKUP(G\$1 & "*",AllJobs,5,0)<=Apr_1,VLOOKUP(G\$1 & "*",AllJobs,6,0)>=Apr_1),AprProjection!G3*@INDEX(Special_Items[[1]:[18]],ROUNDUP((Apr_1-VLOOKUP(G\$1 & "*",AllJobs,5,0))/7,0),VLOOKUP(G\$1 & "*",AllJobs,24,0)),AprProjection!G3*@INDEX(Special_Items_Strike[[1]:[18]],ROUNDUP((Apr_1-VLOOKUP(G\$1 & "*",AllJobs,8,0))/7,0),VLOOKUP(G\$1 & "*",AllJobs,26,0))))),IF(OR(VLOOKUP(G\$1 & "*",AllJobs,5,0)>Apr_1,VLOOKUP(G\$1 & "*",AllJobs,9,0)<Apr_1),0,IF(AND(VLOOKUP(G\$1 & "*",AllJobs,6,0)<=Apr_1,VLOOKUP(G\$1 & "*",AllJobs,8,0)>Apr_1),AprProjection!G3,IF(AND(VLOOKUP(G\$1 & "*",AllJobs,5,0)<=Apr_1,VLOOKUP(G\$1 & "*",AllJobs,6,0)>=Apr_1),AprProjection!G3*@INDEX(Understructure[[1]:[18]],ROUNDUP((Apr_1-VLOOKUP(G\$1 & "*",AllJobs,5,0))/7,0),VLOOKUP(G\$1 & "*",AllJobs,24,0)),AprProjection!G3*@INDEX(Understructure_Strike[[1]:[18]],ROUNDUP((Apr_1-VLOOKUP(G\$1 & "*",AllJobs,8,0))/7,0),VLOOKUP(G\$1 & "*",AllJobs,26,0))))))),0),AprProjection!G3)

So I would like to combine everything into 1 sheet and eliminate 90% of my formulas with a vba code which I can run on demand... I expect it to be pretty beefy and still take a few minutes to compile but I need to make it so i can make all the changes I need to then run the code on demand...(I'm also trying to be efficient considering the code will have to run something like 88mil? loops? maybe my math is bad, depends on how the output if accomplished)

My VBA is passable sometimes lol please don't judge since I'm working on framing work, I believe I know where I want to go so I'm working on each part individually until I get them working, once they work I just push them to the side until the next is done and so forth until I get everything done then I will combine them all and break it differently... I also use msg boxes to step through the code to see where it breaks...

What I'm stuck on currently is changing the value of an array. I have the array, I've set the value of the array to be that of the "Take-Off" (see below the sheet)(just a small sample)

 Category Class Part # Sku Description Inventory 500 Festiv Above the Albertsons American B American C UND UAE BP-1 10030001​ Base Plate - Standard -61​ 53​ 0​ 34​ 0​ 51​ UND UAE BPG-1-SQP 10030004​ Base Plate with Square Pin Galvanized -12​ 0​ 0​ 30​ 0​ 24​ UND UAE SJ-15 10030005​ Base Jack - 15"- (Short Jack) -309​ 0​ 0​ 331​ 0​ 184​ UND UAE SJ-23 10030006​ Base Jack - Regular 23" 538​ 0​ 0​ 383​ 0​ 718​ UND UAE WDF-22 10030010​ 2' x 2' wide Walk Deck Frame 12​ 0​ 0​ 0​ 0​ 0​ UND UAE WDF-22-B 10030011​ 2' x 2' wide Walk Deck Frame - BLACK 0​ 0​ 0​ 0​ 0​ 0​ UND UAE WDF-35 10030019​ 3' x 5' wide Walk Deck Frame 5​ 0​ 0​ 45​ 0​ 0​ UND UAE JR-1 10030028​ 1' Leg Extension -32​ 0​ 0​ 39​ 0​ 30​ UND UAE BOXF-1 10030038​ 1' x 6' Support Box Frame -233​ 0​ 0​ 33​ 0​ 38​ UND UAE BOXF-1-4 10030042​ 1'-4" x 6' Support Box Frame -10​ 0​ 0​ 33​ 0​ 38​ STR UAE BOXF-2 10030043​ 2' x 6' Support Box Frame -74​ 0​ 0​ 114​ 0​ 181​ ACC UAE BOXF-3 10030046​ 3' x 6' Support Box Frame 50​ 0​ 0​ 58​ 0​ 180​ UND UAE BOXF-4 10030050​ 4' x 6' Support Box Frame 329​ 0​ 0​ 42​ 0​ 279​ UND SBX CR-8-7-1 10030102​ Chair Riser - 7' - #1 - 8" Rise -9​ 0​ 0​ 0​ 0​ 10​ STR SBX CR-8-8-1 10030103​ Chair Riser - 8' - #1 - 8" Rise 69​ 0​ 0​ 0​ 0​ 30​ STR SBX CR-8-8-2 10030104​ Chair Riser - 8' - #2 - 8" Rise 20​ 0​ 0​ 0​ 0​ 30​ UND SBX CR-12-7-1 10030114​ Chair Riser - 7' - #1 - 12" Rise 36​ 0​ 0​ 0​ 0​ 0​ ACC SBX CR-12-8-1 10030116​ Chair Riser - 8' - #1 - 12" Rise 0​ 0​ 0​ 0​ 0​ 0​ ACC SBX CR-12-8-2 10030117​ Chair Riser - 8' - #2 - 12" Rise -17​ 0​ 0​ 0​ 0​ 0​ ACC SBX P-BL-12BTR 10030138​ 12' Bleacher Tunnel Truss Putlog 11​ 0​ 0​ 0​ 0​ 0​ ACC SBX P-BL-18BTR 10030140​ 18' Bleacher Tunnel Truss Putlog 3​ 0​ 0​ 0​ 0​ 0​ ACC SBX P-BL8-6 10030147​ 8" x 6' Putlog - Type BL 53​ 0​ 0​ 26​ 0​ 56​ STR SBX P-BL8-9 10030149​ 8" x 9' Putlog - Type BL 49​ 0​ 0​ 28​ 0​ 11​ UND SBX P-BL8-12 10030150​ 8" x 12' Putlog - Type BL 51​ 0​ 0​ 28​ 0​ 19​ UND SBX P-BL8-16 10030153​ 8" x 16' Putlog - Type BL 46​ 0​ 0​ 20​ 0​ 38​ UND SYS SYS-VS-1R 10030235​ Vertical Starter - 1 Ring 0​ 0​ 0​ 176​ 0​ 226​ UND SYS SYS-V.5-1R 10030237​ Vertical - 1/2m - 1 Ring -215​ 0​ 0​ 50​ 0​ 226​ UND SYS SYS-V1-2R 10030238​ Vertical - 1m - 2 Ring -215​ 0​ 0​ 41​ 0​ 274​

---------The array is currently set up to be 1d(=solojob) and it would equal the entirety of COL L (in this case "American C")----------

For jobnum = 1 To JobNumbers
'if there is no t/o for the job in question it just skips to next job
If SoloJob(29) = 0 Then
GoTo Nextjobnum
End If
'populates t/o of job into an array
'Set SoloTO = Sheets("Total_TOs").Range("h3:h2619").Offset(0, SoloJob(29)) '''''(Both set soloto and soloto.value seem to work so i was experimenting with both)
SoloTO = Sheets("Total_TOs").Range("h3:h2619").Offset(0, SoloJob(29)).Value

-----Now I can output this information-----------

'Sheets(SheetsForTables(0)).Range("g2:g2619").Offset(0, SoloJob(29)) = SoloTO() 'works just need to find a way to multiply

-------However I need to adjust the data under variable circumstance so I have 6 2d arrays I need to reference to multiply by the dependent on the the date (below is the for if loops in you care for a reference guide all that is there is the framework. Not only am I referencing dates but if the Category col (above) is "UND" I need to multiply by "x", if its "STR" I need to multiply by "y", and if its "ACC" I need to multiply by "z"--------

'converts date to double for math later changes for each job
StartBDateToDbl = SoloJob(5)
EndBDateToDbl = SoloJob(6)
StartSDateToDbl = SoloJob(8)
EndSDateToDbl = SoloJob(9)
'start to load in the t/o to tables where it pertains
For Week = 43831 To 44202 'need to set to variable for 18 month range
'check that the current "week" is within the job timeline
If Week >= StartBDateToDbl And Week <= EndSDateToDbl Then
'paste using indexed multiplied on tables by week
'week - 43824 / 7 (gives me the week number)(x)
'x
'if event week 100%
'else build 100% * usagebuild
'else strike 100% * usagestrike
If Week > EndBDateToDbl And Week < StartSDateToDbl Then
'paste 100% t/o
GoTo NextWeek
Else
If Week <= EndBDateToDbl Then
'paste indexed number build 100% * usagebuild
GoTo NextWeek
Else
If Week >= StartSDateToDbl Then
100% * usagestrike
GoTo NextWeek
Else
MsgBox ("major error in nest of date display tos")
End If
End If
End If

Else
'drops out if we are past event strike date end for speed
If Week < EndDateToDbl Then
GoTo Nextjobnum
End If
End If
NextWeek:
Week = Week + 6 'to keep it moving forward in week intervals
Next Week

------------------------------------------------------------------------------------------------------------------------------------------------------------------------
TL;DR
I need to either multiply a 1d array with another 1d array
Array1 (1,3,5,4,3,............) * Array2(x,y,x,z,y,.............)
= Array3(1x,3y,5x,4z,3y,......) OR display in COL L (1x,3y,5x,4z,3y........)
OR populate a 2d array at several different times
Array
? , 1 , ?
? , 3 , ?
? , 5 , ?
? , 4 , ?
? , 3 , ?]
'Do some stuff in between not really important but there is a time difference between when i can load in this information since I cant get it until this point
x , 1 , ?
y , 3 , ?
x , 5 , ?
z , 4 , ?
y , 3 , ?]
'do some other stuff(same as before) (OR)(option 1)
x , 1 , 1x
y , 3 , 3y
x , 5 , 5x
z , 4 , 4z
y , 3 , 3y]
OR(option 2)
Display array(multiple) * array(T/O) = "1x,3y,5x,4z,3y........"

*Notes, this does not have to be dynamic, I know everytime my 2d array will be 2619 in length
*I always pasting this information into a col on the same x axis, the y axis is determined with an offset
*I'm looking for the most efficient possible way to do it b/c of the quantity of lines * the quantity of times it will cycle through
*Once the data has been adjusted for the sheet it is no longer needed for other calculations

I'm sorry this was a mile long post, I hope you can garner enough information about what I'm doing//what I need without my code making your eyes bleed haha
I'm willing to discuss on skype or share my file if its too ambiguous what I'm attempting to accomplish through this post.
Thanks

### Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

#### StephenCrump

##### Well-known Member
Welcome to the Forum!

I think the gist of your post is Q: Can I multiply two arrays?

A: Yes.

Here is a trivial example. But no reason you can't build one or both input arrays element by element.

VBA arrays are fast. I don't know where you get your number of 88 million, but even if you do need to loop that many times, it won't take long at all.

ABCD
1InputOutput
2155
32612
43721
54832
Sheet1

VBA Code:
``````Sub Test()

Dim NoRows As Long, i As Long
Dim vIn1 As Variant, vIn2 As Variant, vOut() As Variant

With Worksheets("Sheet1").Range("A2")
NoRows = .Cells(Rows.Count - .Row + 1, .Column).End(xlUp).Row - .Row + 1
ReDim vOut(1 To NoRows, 1 To 1)
vIn1 = .Resize(NoRows).Value
vIn2 = .Offset(, 1).Resize(NoRows).Value
For i = 1 To NoRows
vOut(i, 1) = vIn1(i, 1) * vIn2(i, 1)
Next i
.Offset(, 3).Resize(NoRows).Value = vOut
End With

End Sub``````

#### JosephTL

##### New Member
Stephen, Thanks for your quick reply, I've been working around with this and changed your code up a bit to fit my variable and my particular need. OFC since I don't know what I'm doing I now have an error.
I've stepped through the code and I've managed to Build/populate 2 arrays with the correct values. when I go to multiply them together and fill in the 3rd array I get runtime error subscript out of range.. looking at my local variables before the break they are all the same type/size with Vout being EMPTY. Posting my code again somewhat more refined..... some of the 'notes are for me

VBA Code:
``````        'start to load in the t/o to tables where it pertains
For week = 43831 To 44202 'datevale is 1/1/20-1/6/21' use a cell date in key sheet to allow for adjustment 'runs projection through dates we have
'check that the current "week" is within the job timeline
If week >= StartBDateToDbl And week <= EndSDateToDbl Then
If week > EndBDateToDbl And week < StartSDateToDbl Then
'paste 100% t/o
Sheets(SheetsForTables(1)).Range("h3:h2619").Offset(0, SoloJob(29)) = SoloTO 'works can i change the range to norows?
GoTo NextWeek
Else
If week <= EndBDateToDbl Then
MsgBox ("build")
With Worksheets("total_tos").Range("h3") '.Offset(0, SoloJob(29))
NoRows = .Cells(Rows.Count - .Row + 1, .Column).End(xlUp).Row - .Row + 1 ' sets norows to be the length of the data in the b col)
ReDim CatArray(0 To NoRows) As Variant
For i = 0 To NoRows
If .Cells(i).Offset(0, -6) = "GRD" Or .Cells(i).Offset(0, -6) = "STR" Then 'if the category is steps or guardrail
'CatArray(i) = BuildPicket(SoloJob(27), ((week - StartBDateToDbl) / 7) + 1) 'works
CatArray(i) = 1 'temp holding place for testing
Else
If .Cells(i).Offset(0, -6) = "ACC" Then 'if the category is accessories
'CatArray(i) = BuildSpec(SoloJob(27), ((week - StartBDateToDbl) / 7) + 1) 'works
CatArray(i) = 2 'temp holding place for testing
Else 'if the category is anything else (primiarily lumber/steel)
CatArray(i) = BuildUnder(SoloJob(27), ((week - StartBDateToDbl) / 7) + 1)
End If
End If
ReDim vout(1 To NoRows, 1 To 1)
CatArray = .Resize(NoRows).Value 'needed?
SoloTO = .Offset(, 1).Resize(NoRows).Value 'needed?
MsgBox ("4")
vout(i, 1) = CatArray(i, 1) * SoloTO(i, 1) 'Dies here
MsgBox ("5")
Next i

End With
'paste indexed number
Sheets(SheetsForTables(1)).Range("h3:h2619").Offset(0, SoloJob(29)) = vout 'works can i change the range to norows?
GoTo NextWeek``````

#### StephenCrump

##### Well-known Member
You have declared vOut as starting from row 1.

When Variants CatArray and SoloTO are set equal to SomeRange.Value, they will also start from row 1 (regardless of whether you're using Option Base 0 or Option Base 1).

So you'll need to change:
For i = 1 To NoRows (It's the zero causing the problem)

VBA Code:
``````'You can keep these three lines outside the loop!
ReDim vout(1 To NoRows, 1 To 1)
CatArray = .Resize(NoRows).Value
SoloTO = .Offset(, 1).Resize(NoRows).Value

For i = 0 To NoRows
vout(i, 1) = CatArray(i, 1) * SoloTO(i, 1)
Next i``````

#### JosephTL

##### New Member

Aright,
I get to this line of code preceding the "redim vout(1 to norows, 1 to 1)
I have in information I want.
Soloto has information I want (100, 50,25,ETC)
CatArray has the information I want (.5,.25.4,ETC)
However when it does
Catarray = .resize(norows).value
CatArray values change to exactly what SoloTO is (100, 50,25,ETC)
so when I multiply the 2 I get
10000, 2500, 625
50,13.5,10
am I missing something?

VBA Code:
``````If week <= CDbl(EndBDate) Then
MsgBox ("build")
With Worksheets("total_tos").Range("g3").Offset(0, SoloJob(29))
Norows = .Cells(Rows.Count - .Row + 1, .Column).End(xlUp).Row - .Row + 1 ' sets norows to be the length of the data in the b col)
ReDim CatArray(0 To Norows) As Variant
For i = 0 To Norows
If .Cells(i).Offset(0, -5) = "GRD" Or .Cells(i).Offset(0, -5) = "STR" Then 'if the category is steps or guardrail
CatArray(i) = BuildPicket((((week - CDbl(StartBDate)) / 7) + 2), SoloJob(27))
Else
If .Cells(i).Offset(0, -5) = "ACC" Then 'if the category is accessories
CatArray(i) = BuildSpec((((week - CDbl(StartBDate)) / 7) + 2), SoloJob(27))
Else 'if the category is anything else (primiarily lumber/steel)
CatArray(i) = BuildUnder((((week - CDbl(StartBDate)) / 7) + 2), SoloJob(27))
End If
End If
Next i
ReDim vout(1 To Norows, 1 To 1)
CatArray = .Resize(Norows).Value
SoloTO = .Resize(Norows).Value
For i = 1 To Norows
vout(i, 1) = CatArray(i, 1) * SoloTO(i, 1)
Next i
End With
'paste indexed number
Sheets(SheetsForTables(1)).Range("g3:g2619").Offset(0, SoloJob(29)) = vout 'works can i change the range to norows?
GoTo NextWeek``````

#### StephenCrump

##### Well-known Member
It looks like you've kept bits of my code that you don't need. And you've set CatArray and SoloTO to the same values:
VBA Code:
``````CatArray = .Resize(Norows).Value
SoloTO = .Resize(Norows).Value``````

I can see you have looped to populate each element of CatArray (but wonder whether it should have been populated from 1 to Norows, rather than from 0?)

Where is SoloTo populated? Is it the same size as CatArray?

#### JosephTL

##### New Member

I've populated Soloto Earlier in the loop, however I've kept your code
redim vout(1 to norows, 1 to 1)
CatArray = .Resize(Norows).Value
SoloTO = .Resize(Norows).Value
because if I do not I get a error 9 out of range...
I'm assuming thats because that is changing the array to use the Varient making it 2d rather than just 1d
But when I tried to make it something like

for i = 1 to norows
vout(i) = catarray(i)*soloto(i)
next i
I also get a error 9 out of range

VBA Code:
``````For jobnum = 1 To 3 'JobNumbers '~490+/- 'slimmed down for testing purposes
'if there is no t/o for the job in question it just skips to next job
If SoloJob(29) = 0 Then
GoTo Nextjobnum
End If
'populates t/o of job into an array
SoloTO = Sheets("Total_TOs").Range("g3:g2619").Offset(0, SoloJob(29)) '.Value
'converts date to double for math later changes for each job
StartBDate = SoloJob(5)
EndBDate = SoloJob(6)
StartSDate = SoloJob(8)
EndSDate = SoloJob(9)

'start to load in the t/o to tables where it pertains
Dim week As Double
For week = 43831 To 44202 ' use a cell date in key sheet to allow for adjustment 'runs projection through dates we have
'check that the current "week" is within the job timeline
If week >= CDbl(StartBDate) And week <= CDbl(EndSDate) Then
If week > CDbl(EndBDate) And week < CDbl(StartSDate) Then
'paste 100% t/o
Sheets(SheetsForTables(1)).Range("f3:f2619").Offset(0, SoloJob(29)) = SoloTO 'works can i change the range to norows?
'MsgBox ("100")
GoTo NextWeek
Else
If week <= CDbl(EndBDate) Then
MsgBox ("build")'for testing purposes
With Worksheets("total_tos").Range("g3").Offset(0, SoloJob(29))
Norows = .Cells(Rows.Count - .Row + 1, .Column).End(xlUp).Row - .Row + 1 ' sets norows to be the length of the data in the b col)
ReDim CatArray(0 To Norows) As Variant
For i = 0 To Norows
If .Cells(i).Offset(0, -5 - SoloJob(29)) = "GRD" Or .Cells(i).Offset(0, -5 - SoloJob(29)) = "STR" Then 'if the category is steps or guardrail
CatArray(i) = BuildPicket((((week - CDbl(StartBDate)) / 7) + 2), SoloJob(27))
Else
If .Cells(i).Offset(0, -5 - SoloJob(29)) = "ACC" Then 'if the category is accessories
CatArray(i) = BuildSpec((((week - CDbl(StartBDate)) / 7) + 2), SoloJob(27))
Else 'if the category is anything else (primiarily lumber/steel)
CatArray(i) = BuildUnder((((week - CDbl(StartBDate)) / 7) + 2), SoloJob(27))
End If
End If
Next i
ReDim vout(1 To Norows, 1 To 1)
CatArray = .Resize(Norows).Value
SoloTO = .Resize(Norows).Value
For i = 1 To Norows
vout(i, 1) = CatArray(i, 1) * SoloTO(i, 1)
Next i
End With
'paste indexed number
Sheets(SheetsForTables(1)).Range("g3:g2619").Offset(0, SoloJob(29)) = vout 'works can i change the range to norows?
GoTo NextWeek``````

#### StephenCrump

##### Well-known Member
To multiply two arrays, they will need to be the same size. If you have
VBA Code:
``````Dim MyVariant as Variant

MyVariant = Range("A1:A5").Value``````

then MyVariant will be a 2D array with size 5x1, or to be more precise (1 to 5, 1 to 1).

We can convert to 1D arrays, by using Transpose:
Code:
``MyVariant = Application.Transpose(Range("A1:A5").Value)``

I think you are looking for something along these lines:

Code:
``````Dim vOut As Variant
'other declarations

With Worksheets("total_tos").Range("G3")
NoRows = .Cells(Rows.Count - .Row + 1).End(xlUp).Row - .Row + 1    'length of data in col G
SoloTo = Application.Transpose(.Resize(NoRows).Offset(0, SoloJob(29)).Value)
End With

'Populate CatArray with same dimensions (1 to NoRows)
' ....

ReDim vOut(1 To NoRows)
For i = 1 To NoRows
vOut(i) = SoloTo(i) * CatArray(i)
Next i

'Transpose again to get a column for output, change Z3 depending on where you want the output
Range("Z3").Resize(NoRows).Value = Application.Transpose(vOut)``````

#### JosephTL

##### New Member
I would like to thank you for all your help. I've ran the program multiple time and checked and re-checked the data output and it seem that everything works as designed. For anyone interested if they see this or for yourself below is the posted working code.
VBA Code:
``````Sub UsageModel()
Dim BuildUnder, BuildPicket, BuildSpec, StrikeUnder, StrikePicket, StrikeSpec As Variant ' 2d array for indexed usage %
Dim SheetsForTables, CatArray, vout As Variant
Dim SoloJob, SoloTO, SoloTODisplay, AllTO As Range 'runs the job info along with its take off
Dim Norows As Long 'for finding the length of the table (future proofing)
Dim Week As Double
Dim JobNumbers, OutputWeek As Integer 'keeps track of how many jobs to run
Dim StartBDate, EndBDate, StartSDate, EndSDate As Date 'for dates in the triple if for loop for setting t/os
'places the usage %s into a 2d array for later use
Set BuildUnder = Sheets("Key").Range("O3:al26")
Set BuildPicket = Sheets("Key").Range("O29:al52")
Set BuildSpec = Sheets("Key").Range("O55:al78")
Set StrikeUnder = Sheets("Key").Range("O81:al104")
Set StrikePicket = Sheets("Key").Range("O107:al130")
Set StrikeSpec = Sheets("Key").Range("O133:al156")

SheetsForTables = Array("Week1", "Week2", "Week3", "Week4", "Week5", "Week6", "Week7", "Week8", "Week9", "Week10", "Week11", "Week12", "Week13", "Week14", "Week15", "Week16", "Week17", "Week18", "Week19", "Week20", "Week21", "Week22", "Week23", "Week24", "Week25", "Week26", "Week27", "Week28", "Week29", "Week30", "Week31", "Week32", "Week33", "Week34", "Week35", "Week36", "Week37", "Week38", "Week39", "Week40", "Week41", "Week42", "Week43", "Week44", "Week45", "Week46", "Week47", "Week48", "Week49", "Week50", "Week51", "Week52")
JobNumbers = Sheets("Event_Page").Range("B1")
'places jobs in t/o to weeks 1 - 52 This needs to be on the top of the sub
Set AllTO = Sheets("Total_TOs").Range("h2:ez2")
'///////////////////////////////////////////////////////////////////////////////////////////////////
For i = 0 To 51 '(change to 51)
Sheets(SheetsForTables(i)).Range("g2:ey2") = AllTO() 'places jobname on each weeks worksheet
Next i
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
For jobnum = 1 To JobNumbers
OutputWeek = 0
'if there is no t/o for the job in question it just skips to next job
If SoloJob(29) = 0 Then
GoTo Nextjobnum
End If
'populates t/o of job into an array
With Worksheets("total_tos").Range("g3")
Norows = .Cells(Rows.Count - .Row + 1, .Column).End(xlUp).Row - .Row + 1
SoloTO = Application.Transpose(.Resize(Norows).Offset(0, SoloJob(29)).Value) '.Value
End With

'converts date to double for math later changes for each job
StartBDate = SoloJob(5)
EndBDate = SoloJob(6)
StartSDate = SoloJob(8)
EndSDate = SoloJob(9)

'start to load in the t/o to tables where it pertains
For Week = Worksheets("key").Range("AN12") To Worksheets("key").Range("AN13") 'runs projection through dates we have for 1 year
'check that the current "week" is within the job timeline
If Week >= CDbl(StartBDate) And Week <= CDbl(EndSDate) Then
If Week > CDbl(EndBDate) And Week < CDbl(StartSDate) Then
'paste 100% t/o
Sheets(SheetsForTables(OutputWeek)).Range("f3:f2619").Offset(0, SoloJob(29)) = Application.Transpose(SoloTO) 'works can i change the range to norows?
Sheets(SheetsForTables(OutputWeek)).Range("f2").Offset(0, SoloJob(29)).Interior.ColorIndex = 23
GoTo NextWeek
Else
If Week <= CDbl(EndBDate) Then
With Worksheets("total_tos").Range("g3").Offset(0, SoloJob(29))
ReDim CatArray(0 To Norows) As Variant
For i = 0 To Norows
If .Cells(i).Offset(0, -5 - SoloJob(29)) = "GRD" Or .Cells(i).Offset(0, -5 - SoloJob(29)) = "STR" Then 'if the category is steps or guardrail
CatArray(i) = BuildPicket((((Week - CDbl(StartBDate)) / 7) + 1), SoloJob(27) + 1)
Else
If .Cells(i).Offset(0, -5 - SoloJob(29)) = "ACC" Then 'if the category is accessories
CatArray(i) = BuildSpec((((Week - CDbl(StartBDate)) / 7) + 1), SoloJob(27) + 1)
Else 'if the category is anything else (primiarily lumber/steel)
CatArray(i) = BuildUnder((((Week - CDbl(StartBDate)) / 7) + 1), SoloJob(27) + 1)
End If
End If
Next i
End With
ReDim vout(1 To Norows)
For i = 1 To Norows
vout(i) = Application.WorksheetFunction.RoundUp(CatArray(i) * SoloTO(i), 0)
Next i
'paste indexed number
Sheets(SheetsForTables(OutputWeek)).Range("f3:f2619").Offset(0, SoloJob(29)) = Application.Transpose(vout) 'works can i change the range to norows?
Sheets(SheetsForTables(OutputWeek)).Range("f2").Offset(0, SoloJob(29)).Interior.ColorIndex = 10
GoTo NextWeek
Else
If Week <= CDbl(EndSDate) Then
With Worksheets("total_tos").Range("g3").Offset(0, SoloJob(29))
ReDim CatArray(0 To Norows) As Variant
For i = 0 To Norows
If .Cells(i).Offset(0, -6) = "GRD" Or .Cells(i).Offset(0, -6) = "STR" Then 'if the category is steps or guardrail
CatArray(i) = StrikePicket((((Week - CDbl(StartSDate)) / 7) + 1), SoloJob(28) + 1)
Else
If .Cells(i).Offset(0, -6) = "ACC" Then 'if the category is accessories
CatArray(i) = StrikeSpec((((Week - CDbl(StartSDate)) / 7) + 1), SoloJob(28) + 1)
Else 'if the category is anything else (primiarily lumber/steel)
CatArray(i) = StrikeUnder((((Week - CDbl(StartSDate)) / 7) + 1), SoloJob(28) + 1)
End If
End If
Next i
ReDim vout(1 To Norows)
For i = 1 To Norows
vout(i) = Application.WorksheetFunction.RoundUp(CatArray(i) * SoloTO(i), 0)
Next i
End With
'paste indexed number
Sheets(SheetsForTables(OutputWeek)).Range("f3:f2619").Offset(0, SoloJob(29)) = Application.Transpose(vout) 'works can i change the range to norows?
Sheets(SheetsForTables(OutputWeek)).Range("f2").Offset(0, SoloJob(29)).Interior.ColorIndex = 30
GoTo NextWeek
Else
GoTo Nextjobnum
End If
End If
End If
End If
NextWeek:
Week = Week + 6 'to keep it moving forward in week intervals
OutputWeek = OutputWeek + 1 'moves the sheet week to week forward
Next Week
Nextjobnum:
Next jobnum
End Sub``````

There are still places for me to work on to insure its dynamic rather than static however this code has made a data adjustment process go from 2hrs to 2minutes.

#### StephenCrump

##### Well-known Member
I've ran the program multiple time and checked and re-checked the data output and it seem that everything works as designed.

... this code has made a data adjustment process go from 2hrs to 2minutes.

Great result, well done!