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

[JosephTL]

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
Set SoloJob = Sheets("Event_Page").Range("b2:ad2").Offset(jobnum, 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
'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
[ Multiple, T/O, Adjusted
? , 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
[ Multiple, T/O, Adjusted
x , 1 , ?
y , 3 , ?
x , 5 , ?
z , 4 , ?
y , 3 , ?]
'do some other stuff(same as before) (OR)(option 1)
[ Multiple, T/O, Adjusted
x , 1 , 1x
y , 3 , 3y
x , 5 , 5x
z , 4 , 4z
y , 3 , 3y]
Display Array(adjusted)="1x,3y,5x,4z,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

 

[StephenCrump]

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.

	A	B	C	D
1	Input			Output
2	1	5		5
3	2	6		12
4	3	7		21
5	4	8		32
Sheet1

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]

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

        '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]

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)

'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]

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
Instead of
50,13.5,10
am I missing something?

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]

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:

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]

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

For jobnum = 1 To 3 'JobNumbers '~490+/- 'slimmed down for testing purposes
        Set SoloJob = Sheets("Event_Page").Range("b2:ad2").Offset(jobnum, 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
        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]

To multiply two arrays, they will need to be the same size. If you have

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:

MyVariant = Application.Transpose(Range("A1:A5").Value)

I think you are looking for something along these lines:

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]

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.

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
        Set SoloJob = Sheets("Event_Page").Range("b2:ad2").Offset(jobnum, 0)
        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]

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!