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 very great.

All is working.

The only issue is that that choose function can only display from 1 to 4 ranks. 5th upwards adds nothing.

But in all, I love the code.

Have a wonderful time

 

[DanteAmor]

The only issue is that that choose function can only display from 1 to 4 ranks. 5th upwards adds nothing.

Add in the next line the following letters of the rank

MsgBox "The Rank of id: " & nID & " is: " & nRank & " " & Choose(nRank, "st", "nd", "rd", "th", "th", "th","th","etc")

 

[DanteAmor]

The only issue is that that choose function can only display from 1 to 4 ranks. 5th upwards adds nothing.

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

 

[kelly mort]

Ready with all requests:

Sub test()
  Dim lr As Long, a As Variant, b As Variant
  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
  Sheet2.Range("D7").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  MsgBox "The Rank of id: " & nID & " is: " & nRank & " " & Choose(nRank, "st", "nd", "rd", "th")
End Sub

I just observed something :

The code is not giving me the right results.
The one from post#2 gave me right results.

This line

Sheet2.Range("D7").Resize(UBound(b, 1), UBound(b, 2)).Value = b

Values are scattered, not matching

 

[DanteAmor]

The data on sheet1 should be like this:

 

[kelly mort]

The data on sheet1 should be like this:


View attachment 6894

Oops. Sorry column H is blank.
The data we are working on is from I to AB.

 

[kelly mort]

Oops. Sorry column H is blank.
The data we are working on is from I to AB.

I did it:

  For j = 8 To 17
      Select Case a(i, 3)
        Case "X", "Y", "Z"
          b(i, j - 7) = a(i, j) + a(i, j + 10) * 0.2
        Case Else
          b(i, j - 7) = a(i, j) + a(i, j + 10) * 0.1
      End Select
      nSum = nSum + b(i, j - 7)
    Next

Very grateful

 

[DanteAmor]

Im glad to help you. Thanks for the feed back

 

[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 again @DanteAmor,

I have a situation here with me.

I am assigning the nID to a textbox input.

I click a listbox then the listbox loads the textbox

So nID = UserForm1.txtID.Value

So the goal was to able to switch the ranks as I click my listbox.

But what I am getting is that the display only switches the id values but not the ranks. And even the result produced for the first click is not correct.

I have tried setting f to nothing after the message line but still not getting through.

What could cause this? When I call the code from the user form with nID = 408, it displays the right result for the Id 408.

I just don't know why using the textbox value fails.

 

[DanteAmor]

Put all the code inside your userform. Create a button and on that button run the Test macro.

Change this:
nID = UserForm1.txtID.Value

For this:
nID = Val(UserForm1.txtID.Value)