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

[kelly mort]

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 anymore. So looking at the formula as a guide, I want to perform those calculations in memory. Then I find the totals each row , D:M into N .

All in memory, if only that's possible.

If all the above go well, then what I want next is to be able to rank the total for ID 408 against the items in column N Sheet2 then display outcome with message box.

I wish and hope some can pull it up for me.

Thanks

 

[kelly mort]

You are great.

This line fixed the issue:

nID = Val(UserForm1.txtID.Value)

 

[DanteAmor]

Again with pleasure. Thanks for the feedback

 

[kelly mort]

Try this:

Sub test()
  Dim lr As Long, a As Variant, b As Variant, sufix As String
  Dim i As Long, j As Long, nSum As Double, nRank As Long
  Dim nID As Variant, nMax As Double, sCat As String, f As Range
  
  nID = 408
  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)
  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
      nMax = nSum
    End If
  Next
  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 Right(nRank, 1)
    Case "1": sufix = "st"
    Case "2": sufix = "nd"
    Case "3": sufix = "rd"
    Case Else: sufix = "th"
  End Select
  Sheet2.Range("D7").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  MsgBox "The Rank of id: " & nID & " is: " & nRank & " " & sufix
End Sub

Hi @DanteAmor again,
I want to rank all the processed data, instead of just the total.

So that I can have those individual ranks too displayed.

Like

MsgBox "The Ranks of id: " & nID & " is: " Rank1 & " " & sufix  & " Rank2 & " " & sufix ........& " nRank & " " & sufix

Where the rank1 to rank10 will be those of the individual ranks.

Thanks again

 

[kelly mort]

Hi @DanteAmor,

Please ignore post #23.

I was you to show me how to rank for the first column of the data stored in memory, instead of the totals

In this case I will be able to edit them one by one for what I want to achieve.

 

[DanteAmor]

I was you to show me how to rank for the first column of the data stored in memory, instead of the totals

In this case I will be able to edit them one by one for what I want to achieve.

I did not understand, do you need anything?

 

[kelly mort]

I did not understand, do you need anything?

Yes I need something.

Like the post in #23, I wanted to have ranks for each of the columns that was summed. That's 10 columns.

But I realized that may be one hell of a problem.

So in post #24, what I want to achieve is to switch the rank from the total as done already to the first column in the matrix of the processed data.

So, same criteria as before. Just that this time, we rank the first column of the data that was added to produce the total.

So in this case, assuming the data has been pasted, then we are ranking column D.

I hope this makes it clear

 

[DanteAmor]

You can put the code you are using. An example of your current data and the example of what you want as a result.

 

[kelly mort]

You can put the code you are using. An example of your current data and the example of what you want as a result.

Sheet2

Sheet1

I am using the code as I quoted above.


I am thinking of modifying this part :

For i = 1 To UBound(b)
    If a(i, 3) = sCat And b(i, 11) > nMax Then
      nRank = nRank + 1
    End If
  Next

As :

For i = 1 To UBound(b)
    If a(i, 3) = sCat And b(i, 1) > nMax Then
      nRank = nRank + 1
    End If
  Next

To target the first column in the stored data. Is that correct?

 

[DanteAmor]

please, put here all the current code.

 

[kelly mort]

please, put here all the current code.

This is it:

Sub test()
  Dim lr As Long, a As Variant, b As Variant, sufix As String
  Dim i As Long, j As Long, nSum As Double, nRank As Long
  Dim nID As Variant, nMax As Double, sCat As String, f As Range
  
  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)
  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
      nMax = nSum
    End If
  Next
  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  
End Sub

So I have other textboxes named tb1 to tb10 , they are to take the ranks of each of the 10 columns we added to get the sum. The one which the above code is ranking.

Assuming all the ranks could be done in a single Sub, then I may name the txtRank as tb11. So that all eleven ranks can have their right textboxes.