VBA for Sorting of data

Rahul87

New Member
Joined
Apr 7, 2023
Messages
18
Office Version
  1. 365
  2. 2021
  3. 2019
  4. 2016
  5. 2013
  6. 2011
  7. 2010
  8. 2007
  9. 2003 or older
Platform
  1. Windows
Dear Experts,
please help me out, Any Help would be highly appreciated, I am very much new to the VBA coding in excel and trying to short out some task in excel. I tried hard and found some codes step by step from internet and tried to achieve some of the task, but still unable to achieve the goal. Please help in achieving my goal. Below is full Description.

I have data in excel like this as in image

Capture1.JPG


I want data to be sorted like below in the Image2 on the basis of Column E and ranking should be given in column H and Rank should starts from 1,2,3........ and if value in column E is 0.0% or null value then it should be given Rank at very last or kept at last of the record.

Capture2.JPG


Below is the code in which I am struggling with, but unable to achieve the above task. Please help me to achieve the goal.
VBA Code:
Sub SortAndRank()
    
    ' Define variables
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim sortRange As Range
    Dim rankRange As Range
    Dim i As Long
    Dim nullCount As Long
    
    ' Set worksheet object
    Set ws = ThisWorkbook.Sheets("Sheet2") ' Update with your sheet name
    
    ' Find last row of data in column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' Set range to sort (include headers)
    Set sortRange = ws.Range("A1:H" & lastRow)
    
    ' Move null or 0 values in column E to end of sorted range
    nullCount = Application.WorksheetFunction.CountIf(sortRange.Columns(5), "<>0") + _
                Application.WorksheetFunction.CountIf(sortRange.Columns(5), "")
    If nullCount > 0 Then
        sortRange.Sort Key1:=sortRange.Columns(5), Order1:=xlAscending, _
                        Key2:=sortRange.Columns(8), Order2:=xlAscending, Header:=xlYes
    End If
    
    ' Sort range by column E in descending order
    sortRange.Sort Key1:=sortRange.Columns(5), Order1:=xlDescending, _
                    Key2:=sortRange.Columns(8), Order2:=xlAscending, Header:=xlYes
    
    ' Set range to assign ranks (exclude headers)
    Set rankRange = ws.Range("H" & nullCount + 2 & ":H" & lastRow)
    
    ' Assign ranks and handle null or 0 values in column E
    If nullCount > 0 Then
        For i = 1 To lastRow - nullCount - 1
            If rankRange.Cells(i, 1) = rankRange.Cells(i + 1, 1) Then ' If values in column E are equal
                rankRange.Cells(i + 1, 1) = rankRange.Cells(i, 1) ' Set current cell equal to previous cell
            Else
                rankRange.Cells(i + 1, 1) = i + 1 - nullCount ' Set current cell to next rank
            End If
        Next i
        For i = lastRow - nullCount To lastRow - 1
            rankRange.Cells(i + 1, 1) = "" ' Clear any existing rank values
        Next i
    Else
        rankRange.Cells(1, 1) = 1 ' Set first cell in range to 1
        For i = 2 To lastRow - 1
            If rankRange.Cells(i, 1) = rankRange.Cells(i + 1, 1) Then ' If values in column E are equal
                rankRange.Cells(i + 1, 1) = rankRange.Cells(i, 1) ' Set current cell equal to previous cell
            Else
                rankRange.Cells(i + 1, 1) = i ' Set current cell to next rank
            End If
        Next i
    End If
    
End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Someone else might add their thoughts but as far as I can tell you won't be able to use built-in Excel sorting functionality as-is to do what you want because the sorted data will not be in a normal order (e.g., Ascending).

Here is what I think you are asking for: 1. Sort all data in ascending order. 2.a. "Move" negative numbers to positions below positive numbers. 2.b. Negative numbers should be in descending order. 3. Zero or "null" values are last.

It is not obvious how to order null and zero values so they have the "correct" order and rank. And how do you want to handle ties (if there is more than one occurrence of the same value)?

This certainly could be done. I'd try to assist if you can provide data so I don't need to recreate it. Check out Mr Excel's excellent add-in called XL2BB. See HERE.
 
Upvote 0
Hi all.
Rahul87. You try with:

VBA Code:
Sub SortAndRank()
Dim LR&
With Sheets("Sheet2")
  LR = .Cells(Rows.Count, "E").End(xlUp).Row
  .Range("I2:I" & LR) = "=(E2>0)*E2 + (E2<0)*(100-E2) + (E2=0)*4004"
  .Range("I2:I" & LR) = .Range("I2:I" & LR).Value
  .Range("A1:I" & LR).Sort .[i1], 1, , , , , , True
  .Range("H2") = 1: .Range("H2:H" & LR).DataSeries
  .Range("I2:I" & LR).Delete xlShiftUp
End With
End Sub
 
Upvote 1
Solution
Are the null values the results of a formula, or are they simply empty cells?
HI Kevin thanks, for replying on the post. Please be informed that the null values are the results of a formula and the formula is =(B3-D3)/D3.
 
Upvote 0
HI Kevin thanks, for replying on the post. Please be informed that the null values are the results of a formula and the formula is =(B3-D3)/D3.
Thanks for that - it looks like you have a good solution already in post #4 from @Mario_R
 
Upvote 0
Thanks for that - it looks like you have a good solution already in post #4 from @Mario_R
NO, Kevin still I didn't get the solution, can you please look into my excel. I have attached my excel with this post, please have a look and provide me the solution. It would be highly appreciated, if it would be done.
I have attached the link to download the file and also sharing you the screen shot for better understanding, also you can check with the codes in module. if at least one part in the long list would be sorted our as desired then I will try myself to do it for the Short list.

Link to download the file

1680934399884.png
 
Upvote 0
Hi all.
Rahul87. You try with:

VBA Code:
Sub SortAndRank()
Dim LR&
With Sheets("Sheet2")
  LR = .Cells(Rows.Count, "E").End(xlUp).Row
  .Range("I2:I" & LR) = "=(E2>0)*E2 + (E2<0)*(100-E2) + (E2=0)*4004"
  .Range("I2:I" & LR) = .Range("I2:I" & LR).Value
  .Range("A1:I" & LR).Sort .[i1], 1, , , , , , True
  .Range("H2") = 1: .Range("H2:H" & LR).DataSeries
  .Range("I2:I" & LR).Delete xlShiftUp
End With
End Sub
Thank you very much from my bottom of heart, it really worked, but now I want data should be sorted in the next part also as below at the same time

1680935408088.png
 
Upvote 0
I suppose that you want to apply this new ordering method to the information that is in the column range K:R, right?...
 
Upvote 0
I see that the titles are no longer in row 1 but in row 2.
 
Upvote 0

Forum statistics

Threads
1,224,824
Messages
6,181,187
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top