kelly mort
Well-known Member
- Joined
- Apr 10, 2017
- Messages
- 2,169
- Office Version
- 2016
- Platform
- Windows
I have a table layout as below, it used to work with the code below until I inserted the column under “M” then replaced all 12 with the 13 you see in the code.
And
I was thinking that will fix the new change, just to face issues with excel, crashing when I run the code. This was not happening before.
Also, since my data starts from row 7, I want those with the big minds help me out by pointing out any potential trap in my code for me. It was a code I had from this same forum some time ago, I have adjusted it, but I am thinking there is something that I am not doing right. If that’s true, then, somebody should help me out.
So the data table from A7 to last used row in column O. The above rows are headers. I want to replace that usedRange property in the code and use the slightly static range as I pointed out in the comment. The ranks for column D under column Q, and it follows as the data table.
Please help me out fix it. Thanks in advance
Code:
For i = 2 To 13And
Code:
rCell.Offset(, 13).Value = Rnk & GetOrdinalSuffixForRank(Rnk)I was thinking that will fix the new change, just to face issues with excel, crashing when I run the code. This was not happening before.
Also, since my data starts from row 7, I want those with the big minds help me out by pointing out any potential trap in my code for me. It was a code I had from this same forum some time ago, I have adjusted it, but I am thinking there is something that I am not doing right. If that’s true, then, somebody should help me out.
So the data table from A7 to last used row in column O. The above rows are headers. I want to replace that usedRange property in the code and use the slightly static range as I pointed out in the comment. The ranks for column D under column Q, and it follows as the data table.
Please help me out fix it. Thanks in advance
Code:
6 C D E F G H I J K L M N O
7 x 34 27 43 45 37 34 31 28 25 56 67 371
8 x 48 45 23 39 23 33 30 27 24 98 55 292
9 y 47 40 33 26 19 12 25 23 15 83 55 240
10 y 46 23 25 23 15 10 23 20 13 81 55 198
11 z 35 28 21 14 7 5 17 13 5 23 12 145
Code:
Sub MyRank()
Dim dicSection As Object, vItem As Variant, wsData As Worksheet, vSection As Variant, rScore As Range, _
rCell As Range, Score As Variant, Rnk As Double, LastRow&, iCol&
Application.ScreenUpdating = False
Set wsData = Sheets("Sheet1")
With wsData
If .FilterMode Then .ShowAllData
LastRow = .Cells(Rows.Count, "D").End(xlUp).Row
End With
On Error Resume Next
Set dicSection = CreateObject("Scripting.Dictionary")
dicSection.CompareMode = 1 'vbTextCompare
vSection = wsData.Range("C6:C" & LastRow).Value
For i = LBound(vSection) + 1 To UBound(vSection)
If Not dicSection.Exists(vSection(i, 1)) Then
dicSection(vSection(i, 1)) = ""
End If
Next i
For Each vItem In dicSection.keys()
With wsData. UsedRange ‘ I want to use semi-static range here – like “range(“A7:O” & lastrow)
.AutoFilter field:=3, Criteria1:=vItem
Set rScore = .Offset(1, 1).Resize(Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
For i = 2 To 13
For Each rCell In rScore.Offset(, i)
Score = rCell.Value
If Application.IsNumber(Score) Then
Rnk = WorksheetFunction.Rank(CDbl(Score), rScore.Offset(, i))
rCell.Offset(, 13).Value = Rnk & GetOrdinalSuffixForRank(Rnk)
End If
Next rCell
Next i
.AutoFilter
End With
Next vItem
Application.ScreenUpdating = True
Set dicSection = Nothing
Set rScore = Nothing
Set rCell = Nothing
Exit Sub
On Error GoTo 0
End Sub
Function GetOrdinalSuffixForRank(Rnk As Double) As String
Dim sSuffix$
If Rnk Mod 100 >= 11 And Rnk Mod 100 <= 20 Then
sSuffix = " TH"
Else
Select Case (Rnk Mod 10)
Case 1: sSuffix = " ST"
Case 2: sSuffix = " ND"
Case 3: sSuffix = " RD"
Case Else: sSuffix = " TH"
End Select
End If
GetOrdinalSuffixForRank = sSuffix
End Function
Last edited:
