Another code optimization needed to boast performance

[kelly mort]

This code is taking a bit longer time to run. I want to run all processes in memory before placing result to worksheet.

I took the inspiration from @DanteAmor solution at:

1. Code optimization required - run all processes in memory before placing result to worksheet

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

                    For i = 1 To 10
                        For Each cel In .Range("R7:R" & lr).Offset(, i - 1)
                            Select Case .Cells(cel.Row, "C")
                                Case "Z " & 1 To "Z " & 3
                                    Select Case cel.Value
                                        Case Is >= 83: cel = 1
                                        Case Is >= 76: cel = 2
                                        Case Is >= 69: cel = 3
                                        Case Is >= 60: cel = 4
                                        Case Is >= 50: cel = 5
                                        Case Is >= 40: cel = 6
                                        Case Is >= 30: cel = 7
                                        Case Is >= 20: cel = 8
                                        Case Is >= 1:  cel = 9
                                    End Select
                                Case Else
                                   Select Case cel.Value
                                        Case Is >= 80: cel = 1
                                        Case Is >= 75: cel = 2
                                        Case Is >= 70: cel = 3
                                        Case Is >= 65: cel = 4
                                        Case Is >= 1:  cel = 5
                                    End Select
                            End Select
                        Next cel
                    Next i

Thanks in advance

 

[lrobbo314]

Can you post all of the code? Also, if you post an example of what your data looks like vs. the results your trying to get, that would be helpful.

 

[DanteAmor]

Try this:

Sub test()
  Dim sh As Worksheet, a As Variant, b As Variant, i As Long, j As Long, k As Long
  
  Set sh = Sheets("DATA")
  a = sh.Range("C7:AA" & sh.Range("C" & Rows.Count).End(3).Row).Value2
  ReDim b(1 To UBound(a, 1), 1 To 10)
  
  For i = 1 To UBound(a, 1)   'column C fila 7
    For j = 16 To 25          'columns R to AA
      k = j - 15
      Select Case a(i, 1)
        Case "Z " & 1 To "Z " & 3
          Select Case a(i, j)
            Case Is >= 83: b(i, k) = 1
            Case Is >= 76: b(i, k) = 2
            Case Is >= 69: b(i, k) = 3
            Case Is >= 60: b(i, k) = 4
            Case Is >= 50: b(i, k) = 5
            Case Is >= 40: b(i, k) = 6
            Case Is >= 30: b(i, k) = 7
            Case Is >= 20: b(i, k) = 8
            Case Is >= 1:  b(i, k) = 9
          End Select
        Case Else
          Select Case a(i, j)
            Case Is >= 80: b(i, k) = 1
            Case Is >= 75: b(i, k) = 2
            Case Is >= 70: b(i, k) = 3
            Case Is >= 65: b(i, k) = 4
            Case Is >= 1:  b(i, k) = 5
          End Select
      End Select
    Next j
  Next i
  Range("R7").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

[kelly mort]

Can you post all of the code? Also, if you post an example of what your data looks like vs. the results your trying to get, that would be helpful.

Oops. Sorry for not giving out explicit info. Will work on that afterwards .

 

[kelly mort]

@DanteAmor,

You did it again! !!

Now my codes are running very fast.

 

[DanteAmor]

Again with pleasure. Thanks for the feedback