VBA sorting, stubburn blanks

[Portwolf]

Hello!

I've got a little issue here.
I am pasting data from a sheet into another sheet to order it there:

Sub Workbook_Open()

    Application.ScreenUpdating = False

        Worksheets("OrdLoj").Range("A9:C140").Copy
        Worksheets("preplj").Range("A1").PasteSpecial Paste:=xlPasteValues

    Application.ScreenUpdating = True

End Sub

Well, that works, and it pastes 3 collumns of data with about 30 rows.
It might grow on the source, so i cannot lessen the copy range.
I wanted to sort the data on the paste side, but every time i do it, the ordering sends all the data on the bottom of a whole bunch of blank rows.
As i am looking at this, i see that it is ordering the ammount of cells previously pasted, even if no reference to them on the code..


Needed:
- order the data based on the "C" column value, from highest to lowest.
- set the data on the top ignoring blanks.

What it looks like after paste:

[TABLE="class: grid, width: 200"]
<tbody>[TR]
[TD]store 1[/TD]
[TD]0[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]store 2[/TD]
[TD]1[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]store 3[/TD]
[TD]1[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]store 4[/TD]
[TD]1[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]store 5[/TD]
[TD]0[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]store 6[/TD]
[TD]0[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]store 7[/TD]
[TD]0[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


What it looks like after ordering:

[TABLE="class: grid, width: 200"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]store 3[/TD]
[TD]1[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]store 4[/TD]
[TD]1[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]store 5[/TD]
[TD]0[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]store 2[/TD]
[TD]1[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]store 6[/TD]
[TD]0[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]store 7[/TD]
[TD]0[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]store 1[/TD]
[TD]0[/TD]
[TD]12[/TD]
[/TR]
</tbody>[/TABLE]

What i need (ordered by the last column, other values are not important)

[TABLE="class: grid, width: 200"]
<tbody>[TR]
[TD]store 1[/TD]
[TD]0[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]store 6[/TD]
[TD]0[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]store 7[/TD]
[TD]0[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]store 5[/TD]
[TD]0[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]store 2[/TD]
[TD]1[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]store 4[/TD]
[TD]1[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]store 3[/TD]
[TD]1[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Any ideas will be much appreciated!
Best regards!

 

[igold]

Does this work for you...

Private Sub Workbook_Open()
     
    Dim lRow As Long
    
    Application.ScreenUpdating = False
    Worksheets("OrdLoj").Range("A9:C140").Copy
    Worksheets("preplj").Range("A1").PasteSpecial Paste:=xlPasteValues
    lRow = Sheets("preplj").Cells(Rows.Count, 3).End(xlUp).Row
    ActiveWorkbook.Worksheets("preplj").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("preplj").Sort.SortFields.Add Key:=Range("C1:C" & lRow) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("preplj").Sort
        .SetRange Range("A1:C" & lRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        
    Application.ScreenUpdating = True
    
End Sub

 

[Portwolf]

Hello igold,

Partially, it does the ordering perfectly, but it send the info to the bottom, having a LOT of empty rows until it gets there....
Just like in table 2 of my example, but on perfect order like in table 3.

So, it's half working :D

Thanks!

 

[igold]

Unless I am missing something, if you sort descending on column C the blank rows should fall to the bottom of the sheet...

 

[Portwolf]

Got it.

Added:

    On Error Resume Next
    With Range("A1:C140")
    .Value = .Value
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With

And now it's fixed :D

Thank you for the help!

 

[igold]

Happy to help. I am glad you got it squared away. Thanks for the feedback!