Sorting

[kenpcli]

The cut and sort feature is not working. I need it to look in column 3 and if any of the 3 names appear cut and place them at the bottom after the sort placing 3 empty rows between the final row and the ones I am pasting. Here is the code:


ActiveWorkbook.Worksheets("AnalysisEnd").sort.SortFields.Clear
ActiveWorkbook.Worksheets("AnalysisEnd").sort.SortFields.add Key:=Range("C6:C6"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("AnalysisEnd").sort
.SetRange Range("C6:I1000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

On Error Resume Next
With Columns(3)
.Replace "Totals For NO INSURANCE", True, xlWhole, , False, , False, False
Set Ar = .SpecialCells(xlConstants, xlLogical).Areas
.Replace True, "Totals For NO INSURANCE", xlWhole, , False, , False, False
End With
Resume Next

For Each Rng In Ar
Rng.EntireRow.Copy Range("B" & rows.Count).End(xlUp).Offset(1, -1)
Rng.EntireRow.delete
Next Rng
On Error Resume Next
With Columns(3)
.Replace "Totals For SELF PAY", True, xlWhole, , False, , False, False
Set Ar = .SpecialCells(xlConstants, xlLogical).Areas
.Replace True, "Totals For SELF PAY", xlWhole, , False, , False, False
End With
Resume Next

For Each Rng In Ar
Rng.EntireRow.Copy Range("B" & rows.Count).End(xlUp).Offset(1, -1)
Rng.EntireRow.delete
Next Rng
On Error GoTo 0
Dim f As Range
Set f = [C:C].Find("Totals For NO INSURANCE")
If Not f Is Nothing Then f.Resize(3).EntireRow.insert
With Range("C" & rows.Count).End(xlUp).Offset(1, -2).Resize(, 10)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlDouble
End With

Thank you

 

[pbornemeier]

Your sort key is =Range("C6:C6"). From your sort range I believe the key should be =Range("C7:C1000")
You are sorting columns C:I, but using column B to determine where to move your data. The values in B will no longer be associated with their original neighbors due to the sort.
You said 3 names, but only showed 2.

Please use code tags when posting to preserve indents (see link in my sig)