Auto sort and format and Excel - vba

Question

I have a table of clients in Excel, and I want to be able to add new client into the last row of the table and excel will sort the table automatically so that the client's name will be sorted in alphabetical order.
Also, that the format will be similar to the previous line. for example, the second column is DOB, so I want the format to be the same as the previous row MM/DD/YYYY
Thanks

Answer 1

Put the attached code in your worksheet module and it will sort your column A automatically.
Private Sub Worksheet_Change(ByVal Target As Range)
'turn off updates to speed up code execution
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
If Not Intersect(Target, Columns(1)) Is Nothing Then
With ActiveSheet.Sort
.SetRange Range("A1:X" & Cells(Rows.Count, 1).End(xlUp).Row)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("B").NumberFormat = "MM/DD/YYYY"
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
End With
End Sub

Answer 2

Here's a piece of VBA that would auto-add your table as soon as the first cell on the last row gets typed in. You would have to provide IsChangeInLastLineOfStrRange function and call AddEmptyRowWhenFull from the change-event. It might need tweaking since I removed some code from it. The original has a recursion timer to prevent ... well ... recursion.
Public Sub AddEmptyRowWhenFull(SheetName As String, Area As String, Target As Range)
Dim rngDatabase As Range
With Sheets(SheetName)
If IsChangeInLastLineOfStrRange(SheetName, Area, Target) _
And Target.Value <> "" Then
Set rngDatabase = .Range(Area)
AddEmptyRow rngDatabase, rngDatabase.Rows.Count
End If
End With
End Sub
Public Sub AddEmptyRow(Database As Range, RowPosition As Long, Optional ClearLine As Boolean = True)
Dim bScreenupdate, iCalculation As Integer
Dim colnum As Long, markrow As Long
Dim bUpdate As Boolean
bScreenupdate = Application.ScreenUpdating
iCalculation = Application.Calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Database
If RowPosition < .Rows.Count Then
.Rows(RowPosition - 0).Copy 'Insert in and after data
.Rows(RowPosition + 1).Insert shift:=xlDown
Else
.Rows(RowPosition - 0).Copy 'Add line at end by inserting before last line
.Rows(RowPosition - 0).Insert shift:=xlDown ' to prevent cell formatting below it to be copied too
RowPosition = RowPosition + 1 'Clear last of the copies
End If
If ClearLine = False Then 'Move cursor down
ActiveSheet.Cells(ActiveCell.row + 1, ActiveCell.column).Activate
Else
For colnum = 1 To .Columns.Count 'Preserve formula's
If Not .Rows(RowPosition).Cells(1, colnum).HasFormula Then 'changed
.Rows(RowPosition).Cells(1, colnum).ClearContents
End If
Next colnum
End If
'Fix rowheight if we shift into other heights
.Rows(RowPosition + 1).RowHeight = .Rows(RowPosition + 0).RowHeight
End With
If bScreenupdate = True Then Application.ScreenUpdating = True
If Not iCalculation = xlCalculationManual Then Application.Calculation = iCalculation
End Sub
Arjen.