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]

Hi Fluff,

Sorry to bother you with this old question again.

I actually got stuck right with the last step and wasn't quite able to incorporate the new code snippet into my existing VBA.

Also, when I test the new code snippet on its own, even though it logically does exactly what I want, which is brilliant, it only runs when I click on the macro Play button and doesn't automatically run when cell values are updated, unlike the code I already have. I don't know VBA yet so can't troubleshoot this myself very effectively at the moment. I'm probably missing something obvious!

If you could help me to merge the new code snippet into my existing VBA I would really appreciate it. I tried following your instructions but get various syntax errors, most likely due to my lack of VBA knowledge.

Here's my entire existing VBA, minus the new section that I need to insert. This currently runs whenever any values are updated in the worksheet:

Private Sub Worksheet_Change(ByVal Target As Range)

    Range("A1:D11").Sort Key1:=Range("D1"), _
      Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom
      
    Range("A13:D18").Sort Key1:=Range("D1"), _
      Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom

    Range("A1:C1").BorderAround , xlThick
    Range("D1").BorderAround , xlThick
    Range("A2:A11").BorderAround , xlThick
    Range("B2:B11").BorderAround , xlThick
    Range("C2:C11").BorderAround , xlThick
    Range("D2:D11").BorderAround , xlThick
    
    Range("A13:C13").BorderAround , xlThick
    Range("D13").BorderAround , xlThick
    Range("A14:A18").BorderAround , xlThick
    Range("B14:B18").BorderAround , xlThick
    Range("C14:C18").BorderAround , xlThick
    Range("D14:D18").BorderAround , xlThick
    
    Range("A20:C20").BorderAround , xlThick
    Range("A21:A30").BorderAround , xlThick
    Range("B21:B30").BorderAround , xlThick
    Range("C21:C30").BorderAround , xlThick
    
    Range("C1", Range("C" & Rows.Count).End(xlUp)).Font.Color = vbRed
    
    Columns("A:D").HorizontalAlignment = xlCenter
    
    Range("A20:C30").Sort Key1:=Range("A1"), _
      Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom
    
End Sub

The new section that I'm trying to merge with my existing VBA is shown below, and should replace the first block of the above 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

Any help would be much appreciated!

 

[Fluff]

Try

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
 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
Application.EnableEvents = True
    Range("A13:D18").Sort key1:=Range("D1"), _
      order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom

    Range("A1:C1").BorderAround , xlThick
    Range("D1").BorderAround , xlThick
    Range("A2:A11").BorderAround , xlThick
    Range("B2:B11").BorderAround , xlThick
    Range("C2:C11").BorderAround , xlThick
    Range("D2:D11").BorderAround , xlThick
    
    Range("A13:C13").BorderAround , xlThick
    Range("D13").BorderAround , xlThick
    Range("A14:A18").BorderAround , xlThick
    Range("B14:B18").BorderAround , xlThick
    Range("C14:C18").BorderAround , xlThick
    Range("D14:D18").BorderAround , xlThick
    
    Range("A20:C20").BorderAround , xlThick
    Range("A21:A30").BorderAround , xlThick
    Range("B21:B30").BorderAround , xlThick
    Range("C21:C30").BorderAround , xlThick
    
    Range("C1", Range("C" & Rows.Count).End(xlUp)).Font.Color = vbRed
    
    Columns("A:D").HorizontalAlignment = xlCenter
    
    Range("A20:C30").Sort key1:=Range("A1"), _
      order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom
    
End Sub

 

[wrecclesham]

As usual, your code works perfectly!

Thanks again, Fluff!

 

[Fluff]

You're welcome & thanks for the feedback