My smart tweak ended up crashing excel- I need expert advice and fix

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,575
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.


Code:
     For i = 2 To 13

And


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:

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,919
Office Version
2007
Platform
Windows
If I understood the process well, this should work for the range D7:O lastrow

Code:
Sub MyRank()
  Dim dicSection As Object, vItem As Variant, wsData As Worksheet, vSection As Variant
  Dim rScore As Range, rCell As Range, Score As Variant, Rnk As Double, LastRow&, i As Long
  Application.ScreenUpdating = False
  
  Set wsData = Sheets("Sheet1")
  If wsData.FilterMode Then wsData.ShowAllData
  LastRow = wsData.Cells(Rows.Count, "C").End(xlUp).Row
  Set dicSection = CreateObject("Scripting.Dictionary")
  dicSection.CompareMode = 1 'vbTextCompare
  vSection = wsData.Range("C7:C" & LastRow).Value
  For i = 1 To UBound(vSection)
    dicSection(vSection(i, 1)) = ""
  Next i
  For Each vItem In dicSection.keys()
    With wsData.Range("A6:O" & LastRow)
      .AutoFilter field:=3, Criteria1:=vItem
      Set rScore = .Offset(1, 3).Resize(.Rows.Count - 1, .Columns.Count - 3).SpecialCells(xlCellTypeVisible)
      For Each rCell In rScore
        Score = rCell.Value
        If Application.IsNumber(Score) Then
          Rnk = WorksheetFunction.Rank(CDbl(Score), rScore)
          rCell.Offset(, 13).Value = Rnk & GetOrdinalSuffixForRank(Rnk)
        End If
      Next rCell
      .AutoFilter
    End With
  Next vItem
  Application.ScreenUpdating = True
End Sub
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,575
@DanteAmor

Code:
24 TH    32 ND    19 TH    17 TH    22 ND    24 TH    28 TH    30 TH    35 TH    10 TH    9 TH    1 ST
14 TH    17 TH    39 TH    21 ST    39 TH    26 TH    29 TH    32 ND    38 TH    6 TH    11 TH    2 ND
15 TH    20 TH    26 TH    34 TH    48 TH    55 TH    35 TH    39 TH    50 TH    7 TH    11 TH    3 RD
16 TH    39 TH    35 TH    39 TH    50 TH    57 TH    39 TH    47 TH    53 RD    8 TH    11 TH    4 TH
23 RD    30 TH    46 TH    52 ND    58 TH    59 TH    49 TH    53 RD    59 TH    39 TH    55 TH    5 TH
From the above code you posted, only the last column seems to work correctly for the data I have in the database. Please have a look.
By the way, you fix was faster!!!
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,919
Office Version
2007
Platform
Windows
according to your example, the data starts in cell C7.


Make sure you have data in cells A7 to B11.
If you do not have data in cells A7 to B11 then you have to adjust the code.


<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:29.47px;" /><col style="width:30.42px;" /><col style="width:28.51px;" /><col style="width:28.51px;" /><col style="width:30.42px;" /><col style="width:30.42px;" /><col style="width:25.66px;" /><col style="width:26.61px;" /><col style="width:29.47px;" /><col style="width:27.56px;" /><col style="width:33.27px;" /><col style="width:31.37px;" /><col style="width:31.37px;" /><col style="width:31.37px;" /><col style="width:38.02px;" /><col style="width:38.02px;" /><col style="width:38.97px;" /><col style="width:38.02px;" /><col style="width:38.97px;" /><col style="width:38.02px;" /><col style="width:38.02px;" /><col style="width:38.02px;" /><col style="width:40.87px;" /><col style="width:32.32px;" /><col style="width:31.37px;" /><col style="width:34.22px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >C</td><td >D</td><td >E</td><td >F</td><td >G</td><td >H</td><td >I</td><td >J</td><td >K</td><td >L</td><td >M</td><td >N</td><td >O</td><td >P</td><td >Q</td><td >R</td><td >S</td><td >T</td><td >U</td><td >V</td><td >W</td><td >X</td><td >Y</td><td >Z</td><td >AA</td><td >AB</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td >x</td><td style="text-align:right; ">34</td><td style="text-align:right; ">27</td><td style="text-align:right; ">43</td><td style="text-align:right; ">45</td><td style="text-align:right; ">37</td><td style="text-align:right; ">34</td><td style="text-align:right; ">31</td><td style="text-align:right; ">28</td><td style="text-align:right; ">25</td><td style="text-align:right; ">56</td><td style="text-align:right; ">67</td><td style="text-align:right; ">371</td><td > </td><td >13 TH</td><td >19 TH</td><td >10 TH</td><td >8 TH</td><td >12 TH</td><td >13 TH</td><td >16 TH</td><td >18 TH</td><td >21 ST</td><td >5 TH</td><td >4 TH</td><td >1 ST</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td >x</td><td style="text-align:right; ">48</td><td style="text-align:right; ">45</td><td style="text-align:right; ">23</td><td style="text-align:right; ">39</td><td style="text-align:right; ">23</td><td style="text-align:right; ">33</td><td style="text-align:right; ">30</td><td style="text-align:right; ">27</td><td style="text-align:right; ">24</td><td style="text-align:right; ">98</td><td style="text-align:right; ">55</td><td style="text-align:right; ">292</td><td > </td><td >7 TH</td><td >8 TH</td><td >23 RD</td><td >11 TH</td><td >23 RD</td><td >15 TH</td><td >17 TH</td><td >19 TH</td><td >22 ND</td><td >3 RD</td><td >6 TH</td><td >2 ND</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >9</td><td >y</td><td style="text-align:right; ">47</td><td style="text-align:right; ">40</td><td style="text-align:right; ">33</td><td style="text-align:right; ">26</td><td style="text-align:right; ">19</td><td style="text-align:right; ">12</td><td style="text-align:right; ">25</td><td style="text-align:right; ">23</td><td style="text-align:right; ">15</td><td style="text-align:right; ">83</td><td style="text-align:right; ">55</td><td style="text-align:right; ">240</td><td > </td><td >7 TH</td><td >9 TH</td><td >10 TH</td><td >11 TH</td><td >19 TH</td><td >23 RD</td><td >12 TH</td><td >14 TH</td><td >20 TH</td><td >3 RD</td><td >5 TH</td><td >1 ST</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >10</td><td >y</td><td style="text-align:right; ">46</td><td style="text-align:right; ">23</td><td style="text-align:right; ">25</td><td style="text-align:right; ">23</td><td style="text-align:right; ">15</td><td style="text-align:right; ">10</td><td style="text-align:right; ">23</td><td style="text-align:right; ">20</td><td style="text-align:right; ">13</td><td style="text-align:right; ">81</td><td style="text-align:right; ">55</td><td style="text-align:right; ">198</td><td > </td><td >8 TH</td><td >14 TH</td><td >12 TH</td><td >14 TH</td><td >20 TH</td><td >24 TH</td><td >14 TH</td><td >18 TH</td><td >22 ND</td><td >4 TH</td><td >5 TH</td><td >2 ND</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >11</td><td >z</td><td style="text-align:right; ">35</td><td style="text-align:right; ">28</td><td style="text-align:right; ">21</td><td style="text-align:right; ">14</td><td style="text-align:right; ">7</td><td style="text-align:right; ">5</td><td style="text-align:right; ">17</td><td style="text-align:right; ">13</td><td style="text-align:right; ">5</td><td style="text-align:right; ">23</td><td style="text-align:right; ">12</td><td style="text-align:right; ">145</td><td > </td><td >2 ND</td><td >3 RD</td><td >5 TH</td><td >7 TH</td><td >10 TH</td><td >11 TH</td><td >6 TH</td><td >8 TH</td><td >11 TH</td><td >4 TH</td><td >9 TH</td><td >1 ST</td></tr></table>
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,575
Oh I posted for just one category in C in the last post...

I column Q, the 7th is to be 1st and the 13 th 2nd.

That's how the code I posted used to work.

Thanks
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,919
Office Version
2007
Platform
Windows
Try the following, you just have to start the data range.
According to the following example, the data starts at yield C6

<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:11.41px;" /><col style="width:11.41px;" /><col style="width:24.71px;" /><col style="width:30.42px;" /><col style="width:28.51px;" /><col style="width:28.51px;" /><col style="width:30.42px;" /><col style="width:30.42px;" /><col style="width:25.66px;" /><col style="width:26.61px;" /><col style="width:29.47px;" /><col style="width:27.56px;" /><col style="width:33.27px;" /><col style="width:31.37px;" /><col style="width:31.37px;" /><col style="width:11.41px;" /><col style="width:38.02px;" /><col style="width:38.02px;" /><col style="width:38.97px;" /><col style="width:38.02px;" /><col style="width:38.97px;" /><col style="width:38.02px;" /><col style="width:38.02px;" /><col style="width:38.02px;" /><col style="width:40.87px;" /><col style="width:32.32px;" /><col style="width:31.37px;" /><col style="width:34.22px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td><td >F</td><td >G</td><td >H</td><td >I</td><td >J</td><td >K</td><td >L</td><td >M</td><td >N</td><td >O</td><td >P</td><td >Q</td><td >R</td><td >S</td><td >T</td><td >U</td><td >V</td><td >W</td><td >X</td><td >Y</td><td >Z</td><td >AA</td><td >AB</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td > </td><td > </td><td style="background-color:#ffff00; ">C</td><td >D</td><td >E</td><td >F</td><td >G</td><td >H</td><td >I</td><td >J</td><td >K</td><td >L</td><td >M</td><td >N</td><td >O</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td > </td><td > </td><td >x</td><td style="text-align:right; ">34</td><td style="text-align:right; ">27</td><td style="text-align:right; ">43</td><td style="text-align:right; ">45</td><td style="text-align:right; ">37</td><td style="text-align:right; ">34</td><td style="text-align:right; ">31</td><td style="text-align:right; ">28</td><td style="text-align:right; ">25</td><td style="text-align:right; ">56</td><td style="text-align:right; ">67</td><td style="text-align:right; ">371</td><td > </td><td >13 TH</td><td >19 TH</td><td >10 TH</td><td >8 TH</td><td >12 TH</td><td >13 TH</td><td >16 TH</td><td >18 TH</td><td >21 ST</td><td >5 TH</td><td >4 TH</td><td >1 ST</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td > </td><td > </td><td >x</td><td style="text-align:right; ">48</td><td style="text-align:right; ">45</td><td style="text-align:right; ">23</td><td style="text-align:right; ">39</td><td style="text-align:right; ">23</td><td style="text-align:right; ">33</td><td style="text-align:right; ">30</td><td style="text-align:right; ">27</td><td style="text-align:right; ">24</td><td style="text-align:right; ">98</td><td style="text-align:right; ">55</td><td style="text-align:right; ">292</td><td > </td><td >7 TH</td><td >8 TH</td><td >23 RD</td><td >11 TH</td><td >23 RD</td><td >15 TH</td><td >17 TH</td><td >19 TH</td><td >22 ND</td><td >3 RD</td><td >6 TH</td><td >2 ND</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >9</td><td > </td><td > </td><td >y</td><td style="text-align:right; ">47</td><td style="text-align:right; ">40</td><td style="text-align:right; ">33</td><td style="text-align:right; ">26</td><td style="text-align:right; ">19</td><td style="text-align:right; ">12</td><td style="text-align:right; ">25</td><td style="text-align:right; ">23</td><td style="text-align:right; ">15</td><td style="text-align:right; ">83</td><td style="text-align:right; ">55</td><td style="text-align:right; ">240</td><td > </td><td >7 TH</td><td >9 TH</td><td >10 TH</td><td >11 TH</td><td >19 TH</td><td >23 RD</td><td >12 TH</td><td >14 TH</td><td >20 TH</td><td >3 RD</td><td >5 TH</td><td >1 ST</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >10</td><td > </td><td > </td><td >y</td><td style="text-align:right; ">46</td><td style="text-align:right; ">23</td><td style="text-align:right; ">25</td><td style="text-align:right; ">23</td><td style="text-align:right; ">15</td><td style="text-align:right; ">10</td><td style="text-align:right; ">23</td><td style="text-align:right; ">20</td><td style="text-align:right; ">13</td><td style="text-align:right; ">81</td><td style="text-align:right; ">55</td><td style="text-align:right; ">198</td><td > </td><td >8 TH</td><td >14 TH</td><td >12 TH</td><td >14 TH</td><td >20 TH</td><td >24 TH</td><td >14 TH</td><td >18 TH</td><td >22 ND</td><td >4 TH</td><td >5 TH</td><td >2 ND</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >11</td><td > </td><td > </td><td >z</td><td style="text-align:right; ">35</td><td style="text-align:right; ">28</td><td style="text-align:right; ">21</td><td style="text-align:right; ">14</td><td style="text-align:right; ">7</td><td style="text-align:right; ">5</td><td style="text-align:right; ">17</td><td style="text-align:right; ">13</td><td style="text-align:right; ">5</td><td style="text-align:right; ">23</td><td style="text-align:right; ">12</td><td style="text-align:right; ">145</td><td > </td><td >2 ND</td><td >3 RD</td><td >5 TH</td><td >7 TH</td><td >10 TH</td><td >11 TH</td><td >6 TH</td><td >8 TH</td><td >11 TH</td><td >4 TH</td><td >9 TH</td><td >1 ST</td></tr></table>



Code:
Sub MyRank()
  Dim dicSection As Object, vItem As Variant, wsData As Worksheet, vSection As Variant
  Dim rScore As Range, rCell As Range, Score As Variant, Rnk As Double, LastRow&, i As Long
  Dim rini As Range
  Application.ScreenUpdating = False
  
  Set wsData = Sheets("Sheet1")
  If wsData.FilterMode Then wsData.ShowAllData
  LastRow = wsData.Cells(Rows.Count, "C").End(xlUp).Row
  Set dicSection = CreateObject("Scripting.Dictionary")
  dicSection.CompareMode = 1 'vbTextCompare
[B][COLOR=#0000ff]  Set rini = wsData.Range("C6")[/COLOR][/B]
  
  vSection = rini.Offset(1).Resize(LastRow - rini.Row) '.wsData.Range("C6:C" & LastRow - 1).Offset(1).Value
  For i = 1 To UBound(vSection)
    dicSection(vSection(i, 1)) = ""
  Next i
  For Each vItem In dicSection.keys()
    With rini.Resize(LastRow - rini.Row, 13) 'wsData.Range("C6:O" & LastRow)
      .AutoFilter field:=1, Criteria1:=vItem
      Set rScore = .Offset(1, 1).Resize(.Rows.Count, .Columns.Count - 1).SpecialCells(xlCellTypeVisible)
      For Each rCell In rScore
        Score = rCell.Value
        If Application.IsNumber(Score) Then
          Rnk = WorksheetFunction.Rank(CDbl(Score), rScore)
          rCell.Offset(, 13).Value = Rnk & GetOrdinalSuffixForRank(Rnk)
        End If
      Next rCell
      .AutoFilter
    End With
  Next vItem
  Application.ScreenUpdating = True
  Set dicSection = Nothing
  Set rScore = Nothing
  Set rCell = Nothing
End Sub
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,575
The current code is same as what you first provided.

I want all the rank to look like the one in column AB.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,919
Office Version
2007
Platform
Windows
The codes are different.
Did you try the sample data that I put in my post?


Or what is the problem you have?
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,575
The codes are different.
Did you try the sample data that I put in my post?


Or what is the problem you have?

Yes ,I have tried all codes.

The problem is , from post #6 , under column Q, for category x, it shows 13 th, then 7 th.

Meanwhile, it should have been, 2nd and then 1st .

That's the problem
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,919
Office Version
2007
Platform
Windows
Let me see if I understand.
For category X
D7 = 34
D8 = 48
So
Q7 = 2
Q8 = 1
I was comparing the entire category X. (I fix it)



And what about the Z category
All are going to be 1?


Are there always 1 or 2 records per category? Or can more records come out for a category?
 
Last edited:

Forum statistics

Threads
1,078,437
Messages
5,340,271
Members
399,361
Latest member
Linford

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top