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

 

[DanteAmor]

How about:

Sub test()
  Dim lr As Long, a As Variant, b As Variant
  Dim i As Long, j As Long, nSum As Double
  
  lr = Sheet2.Range("A" & Rows.Count).End(3).Row
  a = Sheet1.Range("I7:AB" & lr).Value2
  ReDim b(1 To UBound(a, 1), 1 To 11)
  For i = 1 To UBound(a)
    nSum = 0
    For j = 1 To 10
      b(i, j) = a(i, j) + a(i, j + 10) * 0.2
      nSum = nSum + b(i, j)
    Next
    b(i, 11) = nSum
  Next
  Range("D7").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

[kelly mort]

How about:

Sub test()
  Dim lr As Long, a As Variant, b As Variant
  Dim i As Long, j As Long, nSum As Double
  
  lr = Sheet2.Range("A" & Rows.Count).End(3).Row
  a = Sheet1.Range("I7:AB" & lr).Value2
  ReDim b(1 To UBound(a, 1), 1 To 11)
  For i = 1 To UBound(a)
    nSum = 0
    For j = 1 To 10
      b(i, j) = a(i, j) + a(i, j + 10) * 0.2
      nSum = nSum + b(i, j)
    Next
    b(i, 11) = nSum
  Next
  Range("D7").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Wow!!!

This runs for about 500 rows in just a blink. Unbelievable.

But it ends at the totals.
Can the rank be made possible?

 

[DanteAmor]

Then I find the totals each row , D:M into N .

I assumed that in column N you wanted the sum of D to M. Is it correct?

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 didn't understand that part, can you explain it?

 

[kelly mort]

I assumed that in column N you wanted the sum of D to M. Is it correct?

Yeah, though I was not initially looking for a physical display but it has opened my eyes to something, a way to speed up my codes.

I didn't understand that part, can you explain it?

What I needed to display initially was only the rank for a given id like the 408 I used. From the sample image I posted, there are 3 category X items.

So after loading the data and getting the totals as you have done nice, I want the total for the Id 408 which is a category X item, ranked against the other two items of category X. Then show that rank on a message box alert.

Either 1st, 2 nd or 3 Rd. The rank too must happen in memory.

Since there are only 3 of them.

 

[DanteAmor]

Try this

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("A:A").Find(nID, , xlValues, xlWhole)
  If Not f Is Nothing Then
    sCat = f.Offset(, 2)
  End If
  
  lr = Sheet2.Range("A" & Rows.Count).End(3).Row
  a = Sheet1.Range("A7:AB" & lr).Value2
  ReDim b(1 To UBound(a, 1), 1 To 11)
  For i = 1 To UBound(a)
    nSum = 0
    For j = 9 To 18
      b(i, j - 8) = a(i, j) + a(i, j + 10) * 0.2
      nSum = nSum + b(i, j - 8)
    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
End Sub

 

[kelly mort]

@DanteAmor,

You are very great creator! !!
Your skills are mind -blowing.

A few finishing touches :
1. My actual data starts from Column B on the sheet1 . I tried amending the code but it seems I need more than what I think I know. Please fix that for me

2. This line;

    b(i, j - 8) = a(i, j) + a(i, j + 10) * 0.2

should switch based on certain category item.
For example if x, y, z then it should be

    b(i, j - 8) = a(i, j) + a(i, j + 10) * 0.2

Else it should be

   b(i, j - 8) = a(i, j) + a(i, j + 10) * 0.1

3. Then finally, I will like to add st , nd , rd, th to the various ranks in the message alert.

I am really learning more from you and the entire family here.

 

[DanteAmor]

My actual data starts from Column B on the sheet1 .

You can put another image where I see the columns on sheet1

I will like to add st , nd , rd, th

st? nd? rd? th?
In the example I don't see that data.
Your request is for ID 408.

Better rethink in a new thread, what do you need to rank.

 

[kelly mort]

You can put another image where I see the columns on sheet1

st? nd? rd? th?
In the example I don't see that data.
Your request is for ID 408.

Yes, I was thinking if st can be added if the rank is first, for example.

Better rethink in a new thread, what do you need to rank.

Okay thanks

 

[DanteAmor]

1. My actual data starts from Column B on the sheet1
2. For example if x, y, z then it should be
3. Then finally, I will like to add st , nd , rd, th

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