Auto Sort with Blank Formulas

[OX_2005]

I am trying to auto sort by Ascending order in the name column of this table. I currently have a formula set up in that column. The code I have written is working but it is putting the Blanks at the top (I am assuming its because they have formulas in them). Is there a way I can have it sort in Ascending order and leave the blanks at the bottom? (Current code below)

Sub SortRosterA()

Dim RA As Worksheet
Set RA = ThisWorkbook.Sheets("Shift Roster T-A 1 3")

'   Unprotect sheet

    RA.Unprotect
   
'   Not Allow screen to update

 Application.ScreenUpdating = False
 
'   Auto Sort

    With RA.ListObjects("DirectA").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("DirectA[Name]"), Order:=xlAscending
        .Apply
    End With



End Sub

 

[Domenic]

Actually, I guess the table could first be sorted in descending order. This would bring the empty rows to the bottom. Then only the other rows could be sorted in ascending order. I'll have a look at this when I get a chance. Hopefully, sometime today.

 

[OX_2005]

Actually, I guess the table could first be sorted in descending order. This would bring the empty rows to the bottom. Then only the other rows could be sorted in ascending order. I'll have a look at this when I get a chance. Hopefully, sometime today.

Thank you. No rush. I am about to be traveling for work for 2 weeks. So hopefully we can have this figured out by the time I get back in the office. LOL

 

[Domenic]

Okay, I've had a chance to look at it. Unfortunately, my idea won't work. Although, it would work if you converted those tables into regular ranges, which could easily be done via a ribbon command. Of course, this would mean you would lose the functionality provided by a table. So, the way I see it (maybe others will have other ideas), here are the options you have available...

1. If the tables on the right don't extend below the the tables on the left, switch them so that the tables on the right are now on the left, and vice versa.
2. Move each table onto their own separate worksheet. Then the macro could loop through each worksheet, and sort each table accordingly.
3. Convert your tables into regular ranges (Ribbon >> Table Design context menu >> Tools group >> Convert to Range). Then the macro could first sort the entire range in descending order, so that the blank rows occur at the bottom. Then it could sort the other rows in ascending order.
4. Convert your tables into regular ranges. Then amend your formulas so that they return "zzzzzzzzzz" instead of a blank (""). Then use conditional formatting to hide "zzzzzzzzzz" values by making the font color the same color as the cell's interior color when a row contains "zzzzzzzzzz". Then, when the macro sorts the data in ascending order, those rows that have "zzzzzzzzzz" values (and that are hidden) will occur at the bottom.

Are any of these options appealing acceptable?

 

[Akuini]

(I am assuming its because they have formulas in them).

1. Is the formula only in the first column (col Name)?
2. What is the formula?

 

[Alex Blakenburg]

@Domenic I think your original concept will work if we just tackle differently.

Instead of Add Column and Delete column use:

1. Resize Table - adding a column
2. Add Sort Helper
3. Resize Table - reducing it by 1 column
4. Clear Content from Helper

1 and 2 can be reversed, 3 & 4 if reversed will require and extra step to remove the header (assuming you let the table generate the column heading in the initial resize)

You can do this quicker than I can if you are happy to keep running with it.

 

[Akuini]

I'd like to try another approach.
1. After sorting data, cut rows with data to the first cell of table dataBodyRange
2. Cut action will remove formula (on the empty rows) so we need to reapply formula in the first column.

I'm assuming:
1. Formula exists in first column only.
2. If cell in first column is empty then the other columns must be empty.

Sub OX_2005_1()

Dim RA As Worksheet
Dim a As Long, LR As Long, n As Long
Dim adr As String


 Application.ScreenUpdating = False
 
'   Auto Sort

    With ActiveSheet.ListObjects(1).Sort
        .SortFields.Clear
        .SortFields.Add Key:=ActiveSheet.ListObjects(1).Range.Columns(1), Order:=xlAscending
        .Apply
    End With

    With ActiveSheet.ListObjects(1)
       a = .Range.Columns(1).Find(What:="*", LookIn:=xlValues, lookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row             'first row with data
       LR = Split(.Range.Address, "$")(4) 'last row of table
       
        With .DataBodyRange
            If a <> .Row Then
              
                adr = Split(.Address, ":")(1) 'last cell of table
                Range(Cells(a, .Column), Range(adr)).Cut .Cells(1) 'cut rows with data to the first cell of table dataBodyRange
               
                'cut action will remove formula (on the empty rows) so we need to reapply formula in the first column
                .Cells(1).Copy
                Range(.Cells(1), Cells(LR, .Column)).PasteSpecial Paste:=xlPasteFormulas 'reapply formula in the first column
                Application.CutCopyMode = False
            Else
                MsgBox "First row is not empty"
            End If
        End With
    End With

End Sub

I tried the code on my own example:

OX_2005 - Auto Sort with Blank Formulas.xlsm
	A	B	C	D	E	F
1
2
3		name	id		2	U
4		Q	6		3	W
5		I	7		4	A
6		A	4		5	T
7		T	5		6	Q
8		U	2		7	I
9					8	G
10					9	R
11		W	3		10	r
12		G	8
13		T	5
14
15
Sheet1

Cell Formulas
Range	Formula
B4:B14	B4	=IFERROR(XLOOKUP(C4,E$3:E$11,F$3:F$11),"")

result:

OX_2005 - Auto Sort with Blank Formulas.xlsm
	A	B	C	D
2
3		name	id
4		A	4
5		G	8
6		I	7
7		Q	6
8		T	5
9		T	5
10		U	2
11		W	3
12
13
14
15
Sheet1

Cell Formulas
Range	Formula
B4:B14	B4	=IFERROR(XLOOKUP(C4,E$3:E$11,F$3:F$11),"")

 

[Domenic]

@Alex Blakenburg

That's it, you've got it!

Resizing the table is the key. That's great, thanks for pointing that out. I really appreciate it.

Here's my code, amended accordingly...

Sub SortRosterA()

'   Not Allow screen to update
    Application.ScreenUpdating = False
 
    Dim RA As Worksheet
    Set RA = ThisWorkbook.Sheets("Shift Roster T-A 1 3")

'   Unprotect sheet
    RA.Unprotect
    
    Dim targetTable As ListObject
    Set targetTable = RA.ListObjects("DirectA")
    
    Dim tableRange As Range
    Set tableRange = targetTable.Range
    
    Dim newTableRange As Range
    With tableRange
        Set newTableRange = .Resize(, .Columns.Count + 1)
    End With
    
    targetTable.Resize newTableRange
  
    Dim tempListColumn As ListColumn
    With targetTable
        Set tempListColumn = .ListColumns(.ListColumns.Count)
    End With
    
    Dim sortListColumn As ListColumn
    Set sortListColumn = targetTable.ListColumns("Name")
 
    Dim rowIndex As Long
    With sortListColumn.DataBodyRange
        For rowIndex = 1 To .Rows.Count
            If Len(.Cells(rowIndex)) = 0 Then
               tempListColumn.DataBodyRange.Cells(rowIndex).Value = "zzzzz"
            Else
                tempListColumn.DataBodyRange.Cells(rowIndex).Value = .Cells(rowIndex).Value
            End If
        Next rowIndex
    End With

'   Auto Sort
    With targetTable.Sort
        .SortFields.Clear
        .SortFields.Add Key:=tempListColumn.Range, Order:=xlAscending
        .Apply
    End With
    
    tempListColumn.DataBodyRange.ClearContents
    
    targetTable.Resize tableRange
    
    Application.ScreenUpdating = True

End Sub

Hope this helps!

 

[OX_2005]

I am sorry I have been missing all the responses. I have been traveling for work. @Akuini the formula been used there is. =IF(B3="","",XLOOKUP(B3,Employees!A:A,Employees!B:B,"",0)).

In each table the 1st Column, 4th Column, 5th Column have formulas
1st Column =IF(B3="","",XLOOKUP(B3,Employees!A:A,Employees!B:B,"",0))
4th Column =IF(B3="","",XLOOKUP(B3,Employees!A:A,Employees!G:G,"",0))
5th Column =XLOOKUP(B3&$M$1,'Attend Data'!$A:$A,'Attend Data'!$P:$P,"",0)

In each table the 2nd & 3rd columns have Data Validation.