VBA code to sort text BEFORE numbers?

wrecclesham

Board Regular
Joined
Jul 24, 2019
Messages
52
Office Version
  1. 365
Platform
  1. Windows
I use the following VBA code to sort a list of dates in ascending order.

Code:
    Range("A1:B10").Sort Key1:=Range("A1"), _
      Order1:=xlAscending, Header:=xlNo, _
      OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom

The problem is that in some cells in the date column, the value is a word rather than a date, and those rows must be sorted above all of the dates. Right now, the cells with text values are moved to the bottom of the list.

Does anyone know how I can modify my existing code to change the sort order slightly, so that any text strings appear at the top of my list, instead of at the bottom?

The dates must still be in ascending order, so I can't solve this by simply switching the sort order to "descending".
 
@MickG

Try this:-
This just sorts the dates then sends the non dates to top of list !!
Code:
[COLOR=Navy]Sub[/COLOR] MG01Aug13
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, nRng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp)).Resize(, 4)
Rng.Sort Range("D2")
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng.Columns(4).Cells
    [COLOR=Navy]If[/COLOR] Not IsDate(Dn.Value) [COLOR=Navy]Then[/COLOR]
        [COLOR=Navy]If[/COLOR] nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]Set[/COLOR] nRng = Dn.Offset(, -3).Resize(, 4)
            Else: [COLOR=Navy]Set[/COLOR] nRng = Union(nRng, Dn.Offset(, -3).Resize(, 4))
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
nRng.Cut
Range("A2").Insert shift:=xlDown
Regards Mick

I'm having some trouble getting your VBA to work for me but it looks promising.

Does it just need an "End Sub" after it?

What about before? Sorry for the basic questions, I'm new to this!
 
Last edited:
Upvote 0

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
I tried using this:

Code:
Sub MG01Aug13()
Dim Rng As Range, Dn As Range, nRng As Range
Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp)).Resize(, 4)
Rng.Sort Range("D2")
For Each Dn In Rng.Columns(4).Cells
    If Not IsDate(Dn.Value) Then
        If nRng Is Nothing Then
            Set nRng = Dn.Offset(, -3).Resize(, 4)
            Else: Set nRng = Union(nRng, Dn.Offset(, -3).Resize(, 4))
        End If
    End If
Next Dn
nRng.Cut
Range("A2").Insert shift:=xlDown
End Sub

But I get this error:

<a href="https://imgur.com/Olam1Po"><img src="https://i.imgur.com/Olam1Po.png" title="source: imgur.com" /></a>

Any ideas?
 
Upvote 0
How about
Code:
Sub wrecclesham()
   With Range("A1", Range("A" & Rows.Count).End(xlUp))
      .Offset(, 4).Formula = "=IF(ISTEXT(D1),1,D1)"
      .Resize(, 5).Sort key1:=Range("e1"), order1:=xlAscending, Header:=xlYes
      .Offset(, 4).Clear
   End With
End Sub
 
Upvote 0
How about
Code:
Sub wrecclesham()
   With Range("A1", Range("A" & Rows.Count).End(xlUp))
      .Offset(, 4).Formula = "=IF(ISTEXT(D1),1,D1)"
      .Resize(, 5).Sort key1:=Range("e1"), order1:=xlAscending, Header:=xlYes
      .Offset(, 4).Clear
   End With
End Sub

Just tried using that code. Getting a run-time error 1004. Hmm.

Feels like this is nearly solved! Just need to figure out why I'm getting a run-time error on my end and to restrict the sorting to A2:D11.
 
Last edited:
Upvote 0
If you only want A1:D11 then use
Code:
Sub wrecclesham()
   With Range("A1:D11")
      .Offset(, 4).Formula = "=IF(ISTEXT(D1),1,D1)"
      .Resize(, 5).Sort key1:=Range("e1"), order1:=xlAscending, Header:=xlYes
      .Offset(, 4).Clear
   End With
End Sub
Which line gives the error & what is the error message?
Also is the sheet protected & do you have any merged cells?
 
Upvote 0
That fixed it!

There was a merged cell in another row, outside of A2:D11. Targeting only these rows prevents any errors appearing at run time.

The dates and text strings are being sorted properly now.

The only issue I'm having at this point is that blank rows (i.e. rows with blank cells in the D column) are being sorted above all rows with data.

Any idea how I can get this script to also move any blank rows to the bottom, instead of stacking them at the top?
 
Last edited:
Upvote 0
How about
Code:
Sub wrecclesham()
   With Range("A1:A11")
      .Offset(, 4).Formula = "=IF(ISTEXT(D1),1,if(d1="""",9999999,D1))"
      .Resize(, 5).Sort key1:=Range("e1"), order1:=xlAscending, Header:=xlYes
      .Offset(, 4).Clear
   End With
End Sub
 
Upvote 0
Works perfectly! Thank you.

I'm trying to insert your code into my existing macro so that it continues to automatically sort the data whenever there are any changes, just using the improved logic.

Here's a simplified version of what I have right now (with most of the old code removed). The first and last lines and the sort logic that is being improved are shown here:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Range("A2:D11").Sort Key1:=Range("D1"), _
      Order1:=xlAscending, Header:=xlNo, _
      OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom
    
End Sub

How can I modify the above code so that your new code replaces it and is run whenever the worksheet is updated?

I'm not really sure about the syntax.
 
Last edited:
Upvote 0
Simply delete everything except the sub & end sub lines & replace it with the code I supplied (less the sub & end sub lines)
 
Upvote 0

Forum statistics

Threads
1,213,490
Messages
6,113,956
Members
448,535
Latest member
alrossman

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