VBA code to sort text BEFORE numbers?

[wrecclesham]

I use the following VBA code to sort a list of dates in ascending order.

    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".

 

[wrecclesham]

@MickG

Try this:-
This just sorts the dates then sends the non dates to top of list !!

[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!

 

[MickG]

Yes, just End Sub at the bottom, sorry about that , copying Error !!

 

[wrecclesham]

I tried using this:

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?

 

[Fluff]

How about

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

 

[wrecclesham]

How about

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.

 

[Fluff]

If you only want A1:D11 then use

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?

 

[wrecclesham]

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?

 

[Fluff]

How about

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

 

[wrecclesham]

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:

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.

 

[Fluff]

Simply delete everything except the sub & end sub lines & replace it with the code I supplied (less the sub & end sub lines)