Sub NewDiagFeatKindList2()
' Shorten Diagnostic Feature Kind choice list
Application.ScreenUpdating = False
' Unprotect Advanced worksheet so Code and Phrase fields can be cleared.
ActiveSheet.Unprotect
For r = 2 To 80 Step 1
If Range("CI" & r) = "" And Range("CJ" & r) <> "" Then
Range("CI" & r & ":CK" & r).Select
Selection.Delete Shift:=xlUp
r = 1
End If
Next r
NewLimit = Application.WorksheetFunction.CountA(Range("CK3:CK81")) + 2
' Do the sort
Range("CJ3:CK" & NewLimit).Select
ActiveWorkbook.Worksheets("Advanced").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Advanced").Sort.SortFields.Add Key:=Range( _
"CJ3:CJ" & NewLimit), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Advanced").Sort
.SetRange Range("CJ3:CK" & NewLimit)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("CI3").Select
' Set Code and Phrase cells yellow with a normal border to indicate to the user
' they are not to edit those cells. They can't anyway, but this is a visual clue.
Range("CJ3:CK" & NewLimit).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("CI3").Select
' Protect Advanced worksheet after creating the new Choice list.
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End Sub