Sort Range Using VBA And Ignoring Or Discarding Blank Rows

[analyst]

I've following code


Range("R3:AC17").Copy
Range("AE3").Select
Selection.PasteSpecial Paste:=xlPasteValues

Selection.Sort Key1:=Range("AE3"), Order1:=xlAscending, Key2:=Range( _
"AL3"), Order2:=xlDescending, Key3:=Range("AM3"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal



However, if there are any blank cells within the range, it comes at the top, after it gets sorted.

How to avoid blank rows/cells at top?

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://eileenslounge.com/viewtopic.php?p=318868#p318868 (https://eileenslounge.com/viewtopic.php?p=318868#p318868)
https://eileenslounge.com/viewtopic.php?p=318311#p318311 (https://eileenslounge.com/viewtopic.php?p=318311#p318311)
https://eileenslounge.com/viewtopic.php?p=318302#p318302 (https://eileenslounge.com/viewtopic.php?p=318302#p318302)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317857#p317857 (https://eileenslounge.com/viewtopic.php?p=317857#p317857)
https://eileenslounge.com/viewtopic.php?p=317541#p317541 (https://eileenslounge.com/viewtopic.php?p=317541#p317541)
https://eileenslounge.com/viewtopic.php?p=317520#p317520 (https://eileenslounge.com/viewtopic.php?p=317520#p317520)
https://eileenslounge.com/viewtopic.php?p=317510#p317510 (https://eileenslounge.com/viewtopic.php?p=317510#p317510)
https://eileenslounge.com/viewtopic.php?p=317547#p317547 (https://eileenslounge.com/viewtopic.php?p=317547#p317547)
https://eileenslounge.com/viewtopic.php?p=317573#p317573 (https://eileenslounge.com/viewtopic.php?p=317573#p317573)
https://eileenslounge.com/viewtopic.php?p=317574#p317574 (https://eileenslounge.com/viewtopic.php?p=317574#p317574)
https://eileenslounge.com/viewtopic.php?p=317582#p317582 (https://eileenslounge.com/viewtopic.php?p=317582#p317582)
https://eileenslounge.com/viewtopic.php?p=317583#p317583 (https://eileenslounge.com/viewtopic.php?p=317583#p317583)
https://eileenslounge.com/viewtopic.php?p=317605#p317605 (https://eileenslounge.com/viewtopic.php?p=317605#p317605)
https://eileenslounge.com/viewtopic.php?p=316935#p316935 (https://eileenslounge.com/viewtopic.php?p=316935#p316935)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317014#p317014 (https://eileenslounge.com/viewtopic.php?p=317014#p317014)
https://eileenslounge.com/viewtopic.php?p=316940#p316940 (https://eileenslounge.com/viewtopic.php?p=316940#p316940)
https://eileenslounge.com/viewtopic.php?p=316927#p316927 (https://eileenslounge.com/viewtopic.php?p=316927#p316927)
https://eileenslounge.com/viewtopic.php?p=316875#p316875 (https://eileenslounge.com/viewtopic.php?p=316875#p316875)
https://eileenslounge.com/viewtopic.php?p=316704#p316704 (https://eileenslounge.com/viewtopic.php?p=316704#p316704)
https://eileenslounge.com/viewtopic.php?p=316412#p316412 (https://eileenslounge.com/viewtopic.php?p=316412#p316412)
https://eileenslounge.com/viewtopic.php?p=316412#p316412 (https://eileenslounge.com/viewtopic.php?p=316412#p316412)
https://eileenslounge.com/viewtopic.php?p=316254#p316254 (https://eileenslounge.com/viewtopic.php?p=316254#p316254)
https://eileenslounge.com/viewtopic.php?p=316046#p316046 (https://eileenslounge.com/viewtopic.php?p=316046#p316046)
https://eileenslounge.com/viewtopic.php?p=317050&sid=d7e077e50e904a138c794e1f2115da95#p317050 (https://eileenslounge.com/viewtopic.php?p=317050&sid=d7e077e50e904a138c794e1f2115da95#p317050)
https://www.youtube.com/@alanelston2330 (https://www.youtube.com/@alanelston2330)
https://www.youtube.com/watch?v=yXaYszT11CA&lc=UgxEjo0Di9-9cnl8UnZ4AaABAg.9XYLEH1OwDIA35HNIei0z- (https://www.youtube.com/watch?v=yXaYszT11CA&lc=UgxEjo0Di9-9cnl8UnZ4AaABAg.9XYLEH1OwDIA35HNIei0z-)
https://eileenslounge.com/viewtopic.php?p=316154#p316154 (https://eileenslounge.com/viewtopic.php?p=316154#p316154)
https://www.youtube.com/watch?v=TW3l7PkSPD4&lc=UgwAL_Jrv7yg7WWC8x14AaABAg (https://www.youtube.com/watch?v=TW3l7PkSPD4&lc=UgwAL_Jrv7yg7WWC8x14AaABAg)
https://teylyn.com/2017/03/21/dollarsigns/#comment-191 (https://teylyn.com/2017/03/21/dollarsigns/#comment-191)
https://eileenslounge.com/viewtopic.php?p=317050#p317050 (https://eileenslounge.com/viewtopic.php?p=317050#p317050)
https://eileenslounge.com/viewtopic.php?f=27&t=40953&p=316854#p316854 (https://eileenslounge.com/viewtopic.php?f=27&t=40953&p=316854#p316854)
https://www.eileenslounge.com/viewtopic.php?v=27&t=40953&p=316875#p316875 (https://www.eileenslounge.com/viewtopic.php?v=27&t=40953&p=316875#p316875)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[Admin]

Hi

Put some fictitious numbers in the blank cells before sorting and replace it after sorting.

[analyst]

I've 20- 25 such ranges on same sheet, which I need to do at one shot, changing manually, and replacing would be time consuming :(

Here is some solution, but I'm not able to change it to my convenience.
http://www.mrexcel.com/forum/excel-questions/317471-ignoring-blank-cells-when-sorting-data.html

[Admin]

Hi

You can do this in the code itself.


Sub kTest()

Dim r As Range

Set r = Range("a1:k100")

Const fNum = -9999999.99

With r
On Error Resume Next
.SpecialCells(4).Value = fNum
'your code for sort
.Replace fNum, vbNullString, 1
End With

End Sub

[analyst]

I replaced my code with your suggestion as under; but the outcome remains as it was earlier.

I mean, blank rows comes at the top of the range.


Sub OSumRank()

Sheets("OSum").Select
Application.ScreenUpdating = False
Columns("R:AC").EntireColumn.AutoFit

Dim r As Range
Set r = Range("ae3:ap17")

Const fNum = -9999999.99

With r
On Error Resume Next
.SpecialCells(4).Value = fNum

Range("R3:AC17").Copy
Range("AE3").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("AE3:Ap17").Select

Selection.Sort Key1:=Range("AE3"), Order1:=xlAscending, Key2:=Range( _
"AL3"), Order2:=xlDescending, Key3:=Range("AM3"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal

.Replace fNum, vbNullString, 1
End With

End Sub

[analyst]

Alternatively, is it possible that, after copy, pastevalue, macro can check the range, and if cell found to be empty, clear content, and then sort.

This I'm saying so because, if i manually press 'DEL' button over blank rows at the top, and re-run the macro, result comes at the top, and blank rows remains at the bottom, that is how i want.

[Admin]

Hi

try this one and let me know if you get any message box pop ups ?


Option Explicit

Sub OSumRank()

Sheets("OSum").Select
Application.ScreenUpdating = False
Columns("R:AC").EntireColumn.AutoFit

Dim r As Range
Dim bCells As Range

Range("R3:AC17").Copy
Range("AE3").Select
Selection.PasteSpecial Paste:=xlPasteValues

Set r = Range("ae3:ap17")

Const fNum = -9999999.99

With r
On Error Resume Next
Set bCells = .SpecialCells(4)
If Not bCells Is Nothing Then
MsgBox dcell.Address
Else
.Sort Key1:=Range("AE3"), Order1:=xlAscending, Key2:=Range( _
"AL3"), Order2:=xlDescending, Key3:=Range("AM3"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
End If
.Replace fNum, vbNullString, 1
End With

End Sub

[analyst]

No message box, macro gets executed, but result as it was earlier. Blank rows are at top. :(

[Admin]

Hi

Could you attach your workbook ?

[analyst]

Thanks for looking at here. The File with original simple vanila macro is attached herewith.

Just run the macro named 'sort', and see the result in range AE3:AP17

Original data, which are derived through Formulas are in range R3:AC17

[Admin]

Hi

try this one. adjust the ranges accordingly.


Option Explicit
Sub Sort1()

Dim NonBlankData(), n As Long, r As Long, c As Long
Dim WholeData

WholeData = Range("R3:AC17").Value2

ReDim NonBlankData(1 To UBound(WholeData, 1), 1 To UBound(WholeData, 2))

For r = 1 To UBound(WholeData, 1)
'//check whether the first column has data. if so, proceed. Replace the 1 with appropriate column to check
If Len(WholeData(r, 1)) Then
n = n + 1
For c = 1 To UBound(WholeData, 2)
NonBlankData(n, c) = WholeData(r, c)
Next
End If
Next

If n Then
With Range("AE3")
.Resize(n, UBound(NonBlankData, 2)).Value2 = NonBlankData
With .Resize(n, UBound(NonBlankData, 2))
.sort Key1:=.Cells(1, 1), Order1:=xlAscending, Key2:=.Cells(1, 8), _
Order2:=xlDescending, Key3:=.Cells(1, 9), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
End With
End With
End If

End Sub

[analyst]

:):)

That worked like a Charm, Thanks a ton.

For other ranges in the same worksheet, I guess, I only need to change


WholeData = Range("R3:AC17").Value2

and rest of the code should be repeated for each range, no need to change the variable, also, I guess. I'll surely try for other ranges.

[analyst]

Code given in #11 works perfectly right, over the given range.

But, Now I want to repeate this process over other row range with same columns, so, I repeated the code as under (without variable, as that have already been declared)


WholeData = Range("R102:AC116").Value2

ReDim NonBlankData(1 To UBound(WholeData, 1), 1 To UBound(WholeData, 2))

For r = 1 To UBound(WholeData, 1)
'//check whether the first column has data. if so, proceed. Replace the 1 with appropriate column to check
If Len(WholeData(r, 1)) Then
n = n + 1
For c = 1 To UBound(WholeData, 2)
NonBlankData(n, c) = WholeData(r, c) ' Error - Run time error 9, Subscript out of Range
Next
End If
Next

If n Then
With Range("AE102")
.Resize(n, UBound(NonBlankData, 2)).Value2 = NonBlankData
With .Resize(n, UBound(NonBlankData, 2))
.sort Key1:=.Cells(1, 1), Order1:=xlAscending, Key2:=.Cells(1, 8), _
Order2:=xlDescending, Key3:=.Cells(1, 9), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
End With
End With
End If

I need to perform similar sorting over row
3 to 17
102 to 116
202 to 216
302 to 316 and so on till 1000+ rows

[Admin]

Hi

I guess the output you want in continuous range. If so, try this


Option Explicit

Sub SortData(ByRef Destination As Range, ParamArray SourceData())

Dim NonBlankData(), n As Long, r As Long, c As Long
Dim WholeData, i As Long

Const MaxOutputRows As Long = 1000
Const OutputColumns As Long = 12

ReDim NonBlankData(1 To MaxOutputRows, 1 To 12)

For i = LBound(SourceData) To UBound(SourceData)
WholeData = SourceData(i)
For r = 1 To UBound(WholeData, 1)
If Len(WholeData(r, 1)) Then
n = n + 1
For c = 1 To UBound(WholeData, 2)
NonBlankData(n, c) = WholeData(r, c)
Next
End If
Next
Next
If n Then
With Destination
.Resize(n, UBound(NonBlankData, 2)).Value2 = NonBlankData
With .Resize(n, UBound(NonBlankData, 2)) 'adjust the sorting columns. here it's 1,8 and 9th column of the output range
.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Key2:=.Cells(1, 8), _
Order2:=xlDescending, Key3:=.Cells(1, 9), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
End With
End With
End If

End Sub

'***** and call the procedure like this...

Sub kTest()

Dim rngDest As Range

Set rngDest = Worksheets("OSum").Range("AE102") '<< adjust the sheet name and the range

With Worksheets("OSum")
SortData rngDest, .Range("ae3:ap17").Value2, .Range("ae102:ap116").Value2, .Range("ae202:ap216").Value2 '<< add more ranges here
End With

End Sub

[analyst]

The revised sheet is attached, with more data in subsequent block every 100th row has 10 rows+column matrix which needs to be copied and sorted.

Somehow, unable to do.

Data position should not be changed, as in the adjacent area many rows columns have data from which some processing is being done, and final output is obtained, which is required to be re-arranged (sorted) from Column AE. Please have a look.

[analyst]

I've 15 such blocks having 10 rows each at interval of 100 rows. Should i create 15 variables, and re-write or how to do, it? Kindly explain.

[Admin]

Hi

As I told you add those 15 ranges in this procedure as an argument and run the macro.


Sub kTest()

Dim rngDest As Range

Set rngDest = Worksheets("OSum").Range("AE102") '<< adjust the sheet name and the range

With Worksheets("OSum")
'I have added 3 ranges here
SortData rngDest, .Range("r3:ac17").Value2, .Range("r102:ac116").Value2, .Range("r202:ac216").Value2 '<< add more ranges here separated by comma
End With

End Sub

Note: I have amended the SortData procedure in my earlier post.

[analyst]

My poor understanding, am not able to do the requisite. :(

[analyst]

I am trying, instead of putting all range in single line, am making different block, and it is working, thank u. Thank you Admin.