The sort works fine. The problem is that it doesn't always get there. This code fails:
Sheets("Members").Select
With Range("B6")
If Len(.Value) Then .Resize(.CurrentRegion.Rows.Count + 100, 38).Clear
Range("B5").PasteSpecial xlPasteFormats
Range("B5").PasteSpecial xlPasteValues
when the data has previously been copied. If the sheet (data area) is blank, the code works.
You might as well always just clear the data area every time, I think. But anyway, try this:
Option Explicit
Sub Member()
Sheets("Personal").Select
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With Sheets("Members")
With .Range("B6")
If Len(.Value) Then .Resize(.CurrentRegion.Rows.Count + 100, 38).Clear
End With
End With
With ActiveSheet.Range("B8:AL5000")
.AutoFilter Field:=37, Criteria1:="<>"
.Copy
With Sheets("Members")
.Range("B5").PasteSpecial xlPasteFormats
.Range("B5").PasteSpecial xlPasteValues
.Range("J:J").EntireColumn.Delete
.Range("K:U").EntireColumn.Delete
End With
End With
Application.AddCustomList _
ListArray:=Array("President", "Vice President", "IPP", "Treasurer", _
"JT. Treasurer", "Hon. Gen. Secretary", "JT. Secretary", "EC Member")
ActiveWorkbook.Worksheets("Members").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Members").Sort.SortFields.Add _
Key:=Range("K5:K35"), SortOn:=xlSortOnValues, Order:=xlAscending, _
CustomOrder:= _
"President,IPP,Vice President,Treasurer,JT. Treasurer,Hon. Gen. Secretary,JT. Secretary,EC Member", _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Members").Sort
.SetRange Range("B5:K35")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
With Worksheets("Members").Range("J" & Rows.Count).End(xlUp).Offset(3)
.Value = Sheets("Information").Range("p10").Value
.Offset(1).Value = Sheets("Information").Range("q10").Value
End With
Sheets("Personal").AutoFilterMode = False
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
.CutCopyMode = False
End With
MsgBox "Congratulation! The member's list is ready!", 64
End Sub
Regards, TMS
Bookmarks