Is there a way for this VBA code to Ignore the spaces & give the results at the top of the page?

RudeBoy

Active Member
Joined
Feb 2, 2003
Messages
431
Office Version
  1. 365
Platform
  1. Windows
I have data that is sorting perfectly but it is at the bottom of the page :(

Here is my VBA:

Sub Worksheet_Activate()
'RnkSrt Macro
Dim SortRange As Range, RowCount As Long, StartRow As Long

With Me
StartRow = 1
RowCount = .UsedRange.Rows.Count
If RowCount > StartRow Then
''Set SortRange = .Range(.Cells(9, 1), .Cells(RowCount, 16))
Set SortRange = .Range(.Cells(1, 1), .Cells(RowCount, 2))

''SortRange.Sort Key1:=.Cells(9, 1), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
SortRange.Sort Key1:=.Cells(1, 1), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Else
MsgBox "No data after Row #" & StartRow & ". There is nothing to sort."
End If
.Range("A1").Activate
End With
End Sub

This is what the results I get: It is exactly what I want accept the results are behind the empty cells :(
I need the perfectly sorted data at the top of the page in A1 Helppppppppp

Here is the current results:
1722278953667.png
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Try removing spaces from cells before sorting.
Try this:
Rich (BB code):
Sub Worksheet_Activate()
  'RnkSrt Macro
  Dim SortRange As Range, RowCount As Long, StartRow As Long
 
  With ActiveSheet
    StartRow = 1
    RowCount = .Range("A" & Rows.Count).End(3).Row
    If RowCount > StartRow Then
      ''Set SortRange = .Range(.Cells(9, 1), .Cells(RowCount, 16))
      Set SortRange = .Range(.Cells(1, 1), .Cells(RowCount, 2))
      SortRange.Columns(1).Replace " ", ""
     
      ''SortRange.Sort Key1:=.Cells(9, 1), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
      SortRange.Sort Key1:=.Cells(1, 1), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Else
      MsgBox "No data after Row #" & StartRow & ". There is nothing to sort."
    End If
    .Range("A1").Activate
  End With
End Sub
 
Upvote 0
Try removing spaces from cells before sorting.
Try this:
Rich (BB code):
Sub Worksheet_Activate()
  'RnkSrt Macro
  Dim SortRange As Range, RowCount As Long, StartRow As Long
 
  With ActiveSheet
    StartRow = 1
    RowCount = .Range("A" & Rows.Count).End(3).Row
    If RowCount > StartRow Then
      ''Set SortRange = .Range(.Cells(9, 1), .Cells(RowCount, 16))
      Set SortRange = .Range(.Cells(1, 1), .Cells(RowCount, 2))
      SortRange.Columns(1).Replace " ", ""
    
      ''SortRange.Sort Key1:=.Cells(9, 1), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
      SortRange.Sort Key1:=.Cells(1, 1), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Else
      MsgBox "No data after Row #" & StartRow & ". There is nothing to sort."
    End If
    .Range("A1").Activate
  End With
End Sub
I put that new code in like this :
1722289834758.png


but still had the same results:

1722289911466.png


Thanks for your Help :-)
 
Upvote 0
1722295536318.png



You didn't mention that you had a formula.
Then in the macro you can change the formulas for values or, in your formula instead of putting "" put 0

Try:
VBA Code:
Sub Worksheet_Activate()
  'RnkSrt Macro
  Dim SortRange As Range, RowCount As Long, StartRow As Long
 
  With ActiveSheet
    StartRow = 1
    RowCount = .Range("A" & Rows.Count).End(3).Row
    If RowCount > StartRow Then
      ''Set SortRange = .Range(.Cells(9, 1), .Cells(RowCount, 16))
      Set SortRange = .Range(.Cells(1, 1), .Cells(RowCount, 2))
      SortRange.Value = SortRange.Value
     
      ''SortRange.Sort Key1:=.Cells(9, 1), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
      SortRange.Sort Key1:=.Cells(1, 1), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Else
      MsgBox "No data after Row #" & StartRow & ". There is nothing to sort."
    End If
    .Range("A1").Activate
  End With
End Sub
 
Upvote 0
View attachment 114695


You didn't mention that you had a formula.
Then in the macro you can change the formulas for values or, in your formula instead of putting "" put 0

Try:
VBA Code:
Sub Worksheet_Activate()
  'RnkSrt Macro
  Dim SortRange As Range, RowCount As Long, StartRow As Long
 
  With ActiveSheet
    StartRow = 1
    RowCount = .Range("A" & Rows.Count).End(3).Row
    If RowCount > StartRow Then
      ''Set SortRange = .Range(.Cells(9, 1), .Cells(RowCount, 16))
      Set SortRange = .Range(.Cells(1, 1), .Cells(RowCount, 2))
      SortRange.Value = SortRange.Value
    
      ''SortRange.Sort Key1:=.Cells(9, 1), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
      SortRange.Sort Key1:=.Cells(1, 1), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Else
      MsgBox "No data after Row #" & StartRow & ". There is nothing to sort."
    End If
    .Range("A1").Activate
  End With
End Sub
thanks that worked :-)
 
Upvote 0
thanks that worked :)
Well I thought it worked but you took the formulas out of my tab
The Formulas need to remain to feed that tab.


This is Formula's for Column A
=IF('M-Mix-Dbls-Final-Pass'!$G20="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I20,""))
=IF('M-Mix-Dbls-Final-Pass'!$G19="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I19,""))
=IF('M-Mix-Dbls-Final-Pass'!$G18="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I18,""))
=IF('M-Mix-Dbls-Final-Pass'!$G17="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I17,""))
=IF('M-Mix-Dbls-Final-Pass'!$G16="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I16,""))
=IF('M-Mix-Dbls-Final-Pass'!$G15="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I15,""))
=IF('M-Mix-Dbls-Final-Pass'!$G14="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I14,""))
=IF('M-Mix-Dbls-Final-Pass'!$G13="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I13,""))
=IF('M-Mix-Dbls-Final-Pass'!$G12="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I12,""))
=IF('M-Mix-Dbls-Final-Pass'!$G11="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I11,""))
=IF('M-Mix-Dbls-Final-Pass'!$G9="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I9,""))
=IF('M-Mix-Dbls-Final-Pass'!$G1="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I1,""))
=IF('M-Mix-Dbls-Final-Pass'!$G6="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I6,""))
=IF('M-Mix-Dbls-Final-Pass'!$G3="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I3,""))
=IF('M-Mix-Dbls-Final-Pass'!$G5="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I5,""))
=IF('M-Mix-Dbls-Final-Pass'!$G10="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I10,""))
=IF('M-Mix-Dbls-Final-Pass'!$G2="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I2,""))
=IF('M-Mix-Dbls-Final-Pass'!$G7="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I7,""))
=IF('M-Mix-Dbls-Final-Pass'!$G4="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I4,""))
=IF('M-Mix-Dbls-Final-Pass'!$G8="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I8,""))
 
Upvote 0
Well I thought it worked but you took the formulas out of my tab
The Formulas need to remain to feed that tab.


This is Formula's for Column A
=IF('M-Mix-Dbls-Final-Pass'!$G20="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I20,""))
=IF('M-Mix-Dbls-Final-Pass'!$G19="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I19,""))
=IF('M-Mix-Dbls-Final-Pass'!$G18="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I18,""))
=IF('M-Mix-Dbls-Final-Pass'!$G17="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I17,""))
=IF('M-Mix-Dbls-Final-Pass'!$G16="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I16,""))
=IF('M-Mix-Dbls-Final-Pass'!$G15="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I15,""))
=IF('M-Mix-Dbls-Final-Pass'!$G14="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I14,""))
=IF('M-Mix-Dbls-Final-Pass'!$G13="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I13,""))
=IF('M-Mix-Dbls-Final-Pass'!$G12="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I12,""))
=IF('M-Mix-Dbls-Final-Pass'!$G11="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I11,""))
=IF('M-Mix-Dbls-Final-Pass'!$G9="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I9,""))
=IF('M-Mix-Dbls-Final-Pass'!$G1="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I1,""))
=IF('M-Mix-Dbls-Final-Pass'!$G6="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I6,""))
=IF('M-Mix-Dbls-Final-Pass'!$G3="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I3,""))
=IF('M-Mix-Dbls-Final-Pass'!$G5="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I5,""))
=IF('M-Mix-Dbls-Final-Pass'!$G10="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I10,""))
=IF('M-Mix-Dbls-Final-Pass'!$G2="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I2,""))
=IF('M-Mix-Dbls-Final-Pass'!$G7="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I7,""))
=IF('M-Mix-Dbls-Final-Pass'!$G4="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I4,""))
=IF('M-Mix-Dbls-Final-Pass'!$G8="0"," ",IFERROR(--'M-Mix-Dbls-Final-Pass'!I8,""))
This is formulas for column B

=IF('M-Mix-Dbls-Final-Pass'!$G20="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J20,""))
=IF('M-Mix-Dbls-Final-Pass'!$G19="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J19,""))
=IF('M-Mix-Dbls-Final-Pass'!$G18="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J18,""))
=IF('M-Mix-Dbls-Final-Pass'!$G17="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J17,""))
=IF('M-Mix-Dbls-Final-Pass'!$G16="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J16,""))
=IF('M-Mix-Dbls-Final-Pass'!$G15="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J15,""))
=IF('M-Mix-Dbls-Final-Pass'!$G14="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J14,""))
=IF('M-Mix-Dbls-Final-Pass'!$G13="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J13,""))
=IF('M-Mix-Dbls-Final-Pass'!$G12="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J12,""))
=IF('M-Mix-Dbls-Final-Pass'!$G11="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J11,""))
=IF('M-Mix-Dbls-Final-Pass'!$G9="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J9,""))
=IF('M-Mix-Dbls-Final-Pass'!$G1="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J1,""))
=IF('M-Mix-Dbls-Final-Pass'!$G6="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J6,""))
=IF('M-Mix-Dbls-Final-Pass'!$G3="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J3,""))
=IF('M-Mix-Dbls-Final-Pass'!$G5="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J5,""))
=IF('M-Mix-Dbls-Final-Pass'!$G10="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J10,""))
=IF('M-Mix-Dbls-Final-Pass'!$G2="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J2,""))
=IF('M-Mix-Dbls-Final-Pass'!$G7="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J7,""))
=IF('M-Mix-Dbls-Final-Pass'!$G4="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J4,""))
=IF('M-Mix-Dbls-Final-Pass'!$G8="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J8,""))
 
Upvote 0
This is formulas for column B

=IF('M-Mix-Dbls-Final-Pass'!$G20="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J20,""))
=IF('M-Mix-Dbls-Final-Pass'!$G19="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J19,""))
=IF('M-Mix-Dbls-Final-Pass'!$G18="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J18,""))
=IF('M-Mix-Dbls-Final-Pass'!$G17="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J17,""))
=IF('M-Mix-Dbls-Final-Pass'!$G16="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J16,""))
=IF('M-Mix-Dbls-Final-Pass'!$G15="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J15,""))
=IF('M-Mix-Dbls-Final-Pass'!$G14="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J14,""))
=IF('M-Mix-Dbls-Final-Pass'!$G13="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J13,""))
=IF('M-Mix-Dbls-Final-Pass'!$G12="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J12,""))
=IF('M-Mix-Dbls-Final-Pass'!$G11="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J11,""))
=IF('M-Mix-Dbls-Final-Pass'!$G9="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J9,""))
=IF('M-Mix-Dbls-Final-Pass'!$G1="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J1,""))
=IF('M-Mix-Dbls-Final-Pass'!$G6="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J6,""))
=IF('M-Mix-Dbls-Final-Pass'!$G3="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J3,""))
=IF('M-Mix-Dbls-Final-Pass'!$G5="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J5,""))
=IF('M-Mix-Dbls-Final-Pass'!$G10="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J10,""))
=IF('M-Mix-Dbls-Final-Pass'!$G2="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J2,""))
=IF('M-Mix-Dbls-Final-Pass'!$G7="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J7,""))
=IF('M-Mix-Dbls-Final-Pass'!$G4="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J4,""))
=IF('M-Mix-Dbls-Final-Pass'!$G8="0"," ",IFERROR('M-Mix-Dbls-Final-Pass'!J8,""))
The results are:

1722300977961.png


Then I was trying to get Row 11 Sorted with the VBA code but do not remove the formulas as I need them each time I run the program to load this tab
We were close but not yet.
 
Upvote 0
Not ideal but give this a try:
Dante might have a better way.

VBA Code:
Sub Worksheet_Activate()
  'RnkSrt Macro
  Dim SortRange As Range, RowCount As Long, StartRow As Long
  Dim SortRangeMod As Range, cellNonBlank As Range
 
  With ActiveSheet
    StartRow = 1
    RowCount = .Range("A" & Rows.Count).End(3).Row
    If RowCount > StartRow Then
      ''Set SortRange = .Range(.Cells(9, 1), .Cells(RowCount, 16))
      Set SortRange = .Range(.Cells(StartRow, 1), .Cells(RowCount, 2))
     
      ''SortRange.Sort Key1:=.Cells(9, 1), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
      SortRange.Sort Key1:=.Cells(StartRow, 1), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False
      Set cellNonBlank = SortRange.Columns(1).Find(What:="*", _
                    After:=.Cells(StartRow, 1), _
                    LookAt:=xlPart, _
                    LookIn:=xlValues, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False)
      
      Set SortRangeMod = .Range(.Cells(StartRow, 1), .Cells(cellNonBlank.Row, 2))
      SortRangeMod.Sort Key1:=.Cells(StartRow, 1), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
      
    Else
      MsgBox "No data after Row #" & StartRow & ". There is nothing to sort."
    End If
    .Range("A1").Activate
  End With
End Sub
 
Upvote 0
Solution
Not ideal but give this a try:
Dante might have a better way.

VBA Code:
Sub Worksheet_Activate()
  'RnkSrt Macro
  Dim SortRange As Range, RowCount As Long, StartRow As Long
  Dim SortRangeMod As Range, cellNonBlank As Range
 
  With ActiveSheet
    StartRow = 1
    RowCount = .Range("A" & Rows.Count).End(3).Row
    If RowCount > StartRow Then
      ''Set SortRange = .Range(.Cells(9, 1), .Cells(RowCount, 16))
      Set SortRange = .Range(.Cells(StartRow, 1), .Cells(RowCount, 2))
    
      ''SortRange.Sort Key1:=.Cells(9, 1), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
      SortRange.Sort Key1:=.Cells(StartRow, 1), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False
      Set cellNonBlank = SortRange.Columns(1).Find(What:="*", _
                    After:=.Cells(StartRow, 1), _
                    LookAt:=xlPart, _
                    LookIn:=xlValues, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False)
     
      Set SortRangeMod = .Range(.Cells(StartRow, 1), .Cells(cellNonBlank.Row, 2))
      SortRangeMod.Sort Key1:=.Cells(StartRow, 1), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
     
    Else
      MsgBox "No data after Row #" & StartRow & ". There is nothing to sort."
    End If
    .Range("A1").Activate
  End With
End Sub
That worked thanks :-)
 
Upvote 0

Forum statistics

Threads
1,224,818
Messages
6,181,150
Members
453,021
Latest member
Justyna P

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