Complex VBA code - Multiple IF conditions including Worksheet Name contains text partially matching Cell

[celebwen_orn]

System: Windows 10, Microsoft Excel Office 16.

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

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:

1. Standard turning off calculation while VBA works it's magic so as to not lag my poor laptop too much
2. Counts number of rows in column C because this is relevant to subsequent transposing
3. 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
   1. Event title as per Column C
   2. The case probability from hidden columns H-K (requires the decimal format for a formula later on)
   3. The lost revenue days from hidden columns L-O
4. 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
5. 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)
6. 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:

Public Sub TurnOffFunctionality()
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
End Sub

Public Sub TurnOnFunctionality()
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Sub t()

'Speed up Macro by turning off calculations
TurnOffFunctionality

' 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[1]+sum(RC[4],RC[6],RC[8]))/(365/4)"
    .Range("E11:E5010").FormulaR1C1 = "=((365/4)-RC[2]+sum(RC[7],RC[9]))/(365/4)"
    .Range("D11:D5010").FormulaR1C1 = "=((365/4)-RC[3])/(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
'Requires For statement with nested if. First if: If InStr(1,SRead.Cells(i,17), "Q1") Then

'Copy across all data from TRead (Q1Y22) to all other Y22 worksheets
Dim ws As Worksheet
Dim wsName As String

'For Each ws In Worksheets
'        If Right(wb.Name, 3) = "Y22" Then
'            With wb.Sheets(..)
'                '~~> Do something - copy across data from Q1Y22??
'            End With
'        End If
'Next ws


'If Condition1 [Right(wb.Name, 2)<Value in Cell X] And Condition 2 [Cell W contains number which mathes Left(wb.Name, 2)] Then
'true_code
'Else
'false_code
'End If



'Turn back on calculation functionalities
TurnOnFunctionality

'Back to manual calculation to prevent lag when changing values in sheet
Application.Calculation = xlCalculationManual


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.
I've considered the following methods but all are incomplete and I still don't actually know how to execute them:

• Possibly copying what's currently in Q1Y22 sheet to all other Y22 sheets (Q2Y22, Q3Y22, Q4Y22) and then trying to do some kind of a loop where the code checks for each event if should apply to that quarter by finding the number 1,2,3 or 4 in Column W and checking it against the second character of the worksheet name. If it is not contained in the worksheet name, it then deletes the two columns associated with that event.
  • I know this is pretty clumsy and it also will make the runtime of the code longer because it's essentially then undoing work - given how much data I'm expecting to end up with, I don't want to use methods which will be too slow
• Trying to figure out how to alter this code from the start to only transpose the data to the relevant worksheets based on the conditions in Columns W and X and then looping through and applying the calculations across all worksheets to come up with the final figures
  • I suspect this is the more 'elegant' solution but have no clue how do the 'If And' statement with this level of complexity

Open to any other suggestions - am still very much a VBA noob who only figures things out by much googling and lurking of other help posts. Any suggestions would be much appreciated (also appreciated if they have an explanation of what any code actually does so I can also learn from it!).

 

[celebwen_orn]

Anyone have any ideas at all?