VBA for Sorting of data

[Rahul87]

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

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.

Below is the code in which I am struggling with, but unable to achieve the above task. Please help me to achieve the goal.

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

 

[OaklandJim]

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.

 

[kevin9999]

value in column E is 0.0% or null value

Are the null values the results of a formula, or are they simply empty cells?

 

[Mario_R]

Hi all.
Rahul87. You try with:

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

 

[Rahul87]

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.

 

[kevin9999]

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

 

[Rahul87]

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

 

[Rahul87]

Hi all.
Rahul87. You try with:

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

 

[Mario_R]

I suppose that you want to apply this new ordering method to the information that is in the column range K:R, right?...

 

[Mario_R]

I see that the titles are no longer in row 1 but in row 2.