I have way exceeded my excel knowledge and am struggling to comprehend how to progress a code to the next stage.
My current set of code works for what it is required to do. I'm trying to develop a probabilistic model (P10/P50/P90) which runs quarterly for 5 years based on a set of inputs which are supplied on a single page. I recognise this is maybe fairly complex (at least for me!!) so I'll try to explain what I've done so far before explaining what I need to do next.
The input sheet (OP Inputs) contains the following user input data:
|Event name||Input by the User in Columns A & B and combined by Excel formula in Column C|
|Probability of each case (Low Case to High High case, some only have 3 cases, some have 4)||Input to Columns D-G (Hidden columns H-K convert these into decimals)|
|Consequence of each case (Matching the Low to High High) in terms of days lost revenue||Input to Columns P-S (Hidden columns L-O convert these into quarterly figures since model is run quarterly not entire year)|
|Random info (not relevant to macro)|
Columns T & U
(See below for input sheet)
So far, this is the only information I have used in my macro which is working (I'll get to the final columns in a bit). My macro code as included below achieves the following things:
- Standard turning off calculation while VBA works it's magic so as to not lag my poor laptop too much
- Counts number of rows in column C because this is relevant to subsequent transposing
- Transposes data from this source workbook, to the target workbook (which is TRead and currently represents Q1 of 2022 hence called Q1Y22). Data transposed includes
- Event title as per Column C
- The case probability from hidden columns H-K (requires the decimal format for a formula later on)
- The lost revenue days from hidden columns L-O
- It then loops back through everything and where there was a 'Title' row in the source worksheet (as you can see in the picture deemed Uncontrollables, Planned, Unplanned), it will delete these empty columns
- Worksheet adds the random trials for the probabilistic modelling (5000 random trials related to the probability - it will return the lost revenue days based on the randomly generated number)
- Finally adds some calculations in Columns A-F of the Target sheet, sorts these to allow excel to find the P10/P50/P90 probabilistic points and summarizes these in a table at the top of the worksheet
See the output in a picture below the code:
Sub t() ' Define worksheets Dim TRead As Worksheet 'Target worksheet for data Set TRead = ThisWorkbook.Worksheets("Q1Y22") Dim SRead As Worksheet 'Source worksheet for data Set SRead = ThisWorkbook.Worksheets("OP Inputs") ' Define the last row to transpose data for based on count in Column 4 Dim LastRow As Long LastRow = SRead.Cells(SRead.Rows.Count, 3).End(xlUp).Row ' Copy across titles to every 2nd column Dim i As Long For i = 1 To LastRow TRead.Cells(4, 5 + i * 2).Value2 = _ SRead.Cells(i, 3).Value2 Next i 'Transpose across the LSD and associated likelihood 'Note Value2 used as faster as does not check cell format For i = 2 To LastRow 'Likelihood TRead.Range(TRead.Cells(5, 2 * i + 5), TRead.Cells(8, 2 * i + 5)).Value = _ WorksheetFunction.Transpose(SRead.Range("H" & i & ":K" & i).Value) 'Lost Stream Days TRead.Range(TRead.Cells(5, 2 * i + 6), TRead.Cells(8, 2 * i + 6)).Value2 = _ WorksheetFunction.Transpose(SRead.Range("L" & i & ":O" & i).Value2) Next i 'Delete colums where 'N/A' is in column G on SRead, Row 5 on TRead (as above code) With TRead Dim delColumns As Range For i = 2 To LastRow If .Cells(6, 2 * i + 5) = "N/A" Then 'Store the Range to delete later or else counting for the columns screws up 'Set the columns for deletion as the range of Column 2*i+4 and column to left If delColumns Is Nothing Then Set delColumns = Range(.Columns(2 * i + 5), .Columns(2 * i + 6)) Else Set delColumns = Application.Union(delColumns, Range(.Columns(2 * i + 5), .Columns(2 * i + 6))) End If End If Next i If Not delColumns Is Nothing Then delColumns.Delete 'Fill out every other columns for 5000 random probablisitic trials Dim t As Long: t = 1 Dim t1 As Long: t1 = 1 Dim arr(1 To 5000, 1 To 1) As Variant For trial = 1 To 5000 Step 1 arr(t1, 1) = trial t1 = t1 + 1 Next trial 'Place array values in Cell G11 and every 2nd column to match probabilistic trials For i = 2 To LastRow - 3 .Cells(11, 2 * i + 5).Resize(5000).Value2 = arr Next i 'Insert Vlookup in first cell using random variable between 0-1 'to search probabilities (i.e G5:G8) with an absolute reference (R1C1 notation) For i = 2 To LastRow - 3 .Cells(11, 2 * i + 6).FormulaR1C1 = "=VLOOKUP(RAND(),R5C[-1]:R8C,2)" 'Now copy this absolute formula to other cells Range(.Cells(12, 2 * i + 6), .Cells(5010, 2 * i + 6)).Formula = .Cells(11, 2 * i + 6).Formula Next i End With 'Fill out random columns for overall calcs. Use arrays where possible for speed 'Insert column F for the trails to allow P10, P50, P90 determination Dim trialF As Variant For trialF = 0.0002 To 1 Step 0.0002 arr(t, 1) = trialF t = t + 1 Next trialF 'Place array values in Cell F11 TRead.Cells(11, 8).Resize(5000).Value2 = arr 'Insert Column G for sum of all LSD Dim LastColumn As Long LastColumn = TRead.Cells(5, 9).End(xlToRight).Column Dim i2 As Long With TRead Set f1 = .Cells(11, 10) For i = 10 To LastColumn Step 2 Set f1 = Union(f1, .Cells(11, i)) Next i Set f2 = .Cells(11, "G") For i2 = 1 To 4999 Step 1 Set f2 = Union(f2, .Cells(11 + i2, "G")) Next i2 f2.Formula = "=sum(" & f1.Address(0, 0) & ")" 'Column D to calculate availability (excludes planned and uncontrollables) 'Column C to calculate reliability .Range("F11:F5010").FormulaR1C1 = "=((365/4)-RC+sum(RC,RC,RC))/(365/4)" .Range("E11:E5010").FormulaR1C1 = "=((365/4)-RC+sum(RC,RC))/(365/4)" .Range("D11:D5010").FormulaR1C1 = "=((365/4)-RC)/(365/4)" ' ^ Not currently required as only needed to be pasted on page once .Range("A11:C5010").Value2 = TRead.Range("D11:F5010").Value2 .Range("C11:C5010").Sort Key1:=.Range("C11"), Order1:=xlAscending, Header:=xlNo .Range("B11:B5010").Sort Key1:=.Range("B11"), Order1:=xlAscending, Header:=xlNo .Range("A11:A5010").Sort Key1:=.Range("A11"), Order1:=xlAscending, Header:=xlNo End With 'Alternative would be along the lines of: 'Dim sumFormula As Variant 'For i = 2 To LastColumn ' For k = 1 To LastColumn Step 2 ' sumFormula = sumFormula + TRead.Cells(11, k + 7) ' Next k ' TRead.Cells(11, 5).Formula = sumFormula 'Next i 'Calculate overall Reliability, Availability & Utilisation for quarter With TRead Dim ColHeadings As Variant ColHeadings = VBA.Array("P10", "P50", "P90") .Range("A2:A4").Value2 = Application.WorksheetFunction.Transpose(ColHeadings) Dim RowHeadings As Variant RowHeadings = VBA.Array("Reliability", "Availability", "Utilisation") .Range("B1:D1").Value2 = RowHeadings 'Insert formula to look up P10/P50/P90 matches .Cells(2, 2).FormulaR1C1 = "=INDEX(R11C1:R5010C1,MATCH(90%,R11C8:R5010C8))" .Cells(3, 2).FormulaR1C1 = "=INDEX(R11C1:R5010C1,MATCH(50%,R11C8:R5010C8))" .Cells(4, 2).FormulaR1C1 = "=INDEX(R11C1:R5010C1,MATCH(10%,R11C8:R5010C8))" .Cells(2, 3).FormulaR1C1 = "=INDEX(R11C2:R5010C2,MATCH(90%,R11C8:R5010C8))" .Cells(3, 3).FormulaR1C1 = "=INDEX(R11C2:R5010C2,MATCH(50%,R11C8:R5010C8))" .Cells(4, 3).FormulaR1C1 = "=INDEX(R11C2:R5010C2,MATCH(10%,R11C8:R5010C8))" .Cells(2, 4).FormulaR1C1 = "=INDEX(R11C3:R5010C3,MATCH(90%,R11C8:R5010C8))" .Cells(3, 4).FormulaR1C1 = "=INDEX(R11C3:R5010C3,MATCH(50%,R11C8:R5010C8))" .Cells(4, 4).FormulaR1C1 = "=INDEX(R11C3:R5010C3,MATCH(10%,R11C8:R5010C8))" End With End Sub
I'm honestly happy and impressed I got that far. Excuse the incomplete scribbles in the code at the bottom - that's me trying to work out this next piece.
As you can see from the above screenshot, there are multiple tabs for every Quarter (Q1-Q4) for the next five years (until end 2026).
What I need to do next is essentially what I've done, but for all other tabs and pending data on the input page in Columns W and X.
Column W captures in which Quarters, the event has an impact. For some events, they only impact in certain quarters (i.e the weather line which only impacts operations in Q1 and Q4), but others may impact across all or sporadic quarters
Column X captures when the impact is expected to end. For weather - there is no end. But for other issues (Covid for example), there's expected to be no ongoing inpact past 2022.
So what my macro needs to do next is:
- Only copy across the Event and Impacts (and subsequently generate the trials etc) if the Event has an impact in that relevant Quarter (i.e Weather should only copy across to all worksheets starting with Q1 and Q4)
- Only copy across the Event and impacts up until (and including) the year it impacts until. So Covid should only copy across to Q1Y22 and Q2Y22 worksheets as it no longer applies from 2023 onwards.
I'm struggling to figure out how to alter my code for this next step.