Code amendment needed - Load a range of data into memory, perform some calculations and rank then show alert with message box - VBA

[kelly mort]

This post is an upgrade of the problem and solution provided by @DanteAmor post #39 at:

Load part of data to memory, perform some calculations and rank then show alert with message box -vba

This is the formula I am using to get data to second sheet. Sheet2.Range("D7:M" & lr) = "=Sheet1!I7+Sheet1!S7*0.2" Sheet1 Sheet2 Now what I want to do is to be able to load the portion of data from sheet2 for say category "X" into memory. Now I don't want to interact with the worksheet...

www.mrexcel.com

Sub test()
  Dim lr As Long, a As Variant, b As Variant, c As Variant, sufix As String
  Dim i As Long, j As Long, k As Long, nSum As Double, nRank As Long
  Dim nID As Variant, nMax As Double, sCat As String, f As Range
  Dim nTot As Double, nCon As Long
  
  nID = Val(UserForm1.txtID.Value)

  Set f = Sheet1.Range("B:B").Find(nID, , xlValues, xlWhole)
  If Not f Is Nothing Then
    sCat = f.Offset(, 2)
  End If
  
  lr = Sheet2.Range("B" & Rows.Count).End(3).Row
  a = Sheet1.Range("B7:AA" & lr).Value2
  ReDim b(1 To UBound(a, 1), 1 To 11)
  ReDim c(1 To 1, 1 To 10)
  
  For i = 1 To UBound(a)
    nSum = 0
    For j = 7 To 16
      Select Case a(i, 3)
        Case "X", "Y", "Z"
          b(i, j - 6) = a(i, j) + a(i, j + 10) * 0.2
        Case Else
          b(i, j - 6) = a(i, j) + a(i, j + 10) * 0.1
      End Select
      nSum = nSum + b(i, j - 6)
    Next
    b(i, 11) = nSum
    If a(i, 1) = nID Then
      For k = 1 To 10
        c(1, k) = b(i, k)
      Next
      nMax = nSum
    End If
  Next
  
'RANKS
  nRank = 1
  For i = 1 To UBound(b)
    If a(i, 3) = sCat And b(i, 11) > nMax Then
      nRank = nRank + 1
    End If
  Next
  
  Select Case nRank
    Case 11 To 13
      sufix = "th"
    Case Else
      Select Case Right(nRank, 1)
        Case "1": sufix = "st"
        Case "2": sufix = "nd"
        Case "3": sufix = "rd"
        Case Else: sufix = "th"
      End Select
  End Select
  UserForm1.txtRank.Value = nRank & " " & sufix
  
  For j = 1 To 10
    nRank = 1
    For i = 1 To UBound(b)
      If a(i, 3) = sCat And b(i, j) > c(1, j) Then
        nRank = nRank + 1
      End If
    Next
    Select Case nRank
      Case 11 To 13
        sufix = "th"
      Case Else
        Select Case Right(nRank, 1)
          Case "1": sufix = "st"
          Case "2": sufix = "nd"
          Case "3": sufix = "rd"
          Case Else: sufix = "th"
        End Select
    End Select
    UserForm1.Controls("tb" & j).Value = nRank & " " & sufix
  Next

'AVERAGE
  For j = 1 To 11
    nTot = 0
    nCon = 0
    For i = 1 To UBound(b)
      If a(i, 3) = sCat And b(i, j) > 0 Then
        nTot = nTot + b(i, j)
        nCon = nCon + 1
      End If
    Next
    UserForm1.Controls("txtAve" & j).Value = nTot / nCon
  Next
End Sub

Now I have added more columns and I have AR as the last column ATM.

Instead of using only the unique items in column D to do the switches, I am adding AQ and AR.

Under AQ are strings in the form "Year1/Year2" eg 2020/2021
Then AR has strings like "LEVEL 1".

So under 2020/2021, the will or can be LEVEL 1, LEVEL 2, LEVEL 3 and so on.

Then the same thing could happen to 2021/2022 and so on.

So a criterion in column D, say X, having an ID of 7, could exit 3 times the number of different year ranges in column AQ as described above.

That's 2020/2021 will have

B      C            D     ......  AQ                   AR
ID    Name    Cat  ...... Year                  LEVEL
7     Ben 10   x      ...... 2020/2021      LEVEL 1
7     Ben 10   x      ...... 2020/2021      LEVEL 2
7     Ben 10   x      ...... 2020/2021      LEVEL 3

Then when we get to 2021/2022, the same ID will appear .

Which year range and LEVEL to handle is supplied by these two variable :

MyYear = "2020/2021"
MyLevel = "LEVEL 1"

As examples.

How do I tweak or amend the above code to get the job done for me?

Thanks in advance.
Kelly