Sort is not sorting all data in the same row....Really!

[CastingDirector]

I would be so grateful for any/all help.
So here is the data BEFORE the sort macro (note actor A has corresponding notes in the same row (e)):

NAA	10/02/15	Actor D		Carol|Notes on Actor D
NAA	10/02/15	Actor E		Ted|Notes on Actor E
NAA	10/02/15	Actor F		Ted|Notes on Actor F
NAA	10/02/15	Actor G		Bob|No Notes
NAA	10/02/15	Actor H		Ted|Notes on Actor H
NA	10/02/15	Actor C		Bob|Notes on Actor C
NAA	10/02/15	Actor A		Carol|Notes on A
PASS	10/02/15	Actor B		Alice|Notes on B

<tbody>
</tbody>

NOW AFTER THE CODE is processed with the macro:

	Alice
NAA	10/02/15	Actor D		Notes on B
	Bob
NAA	10/02/15	Actor E		No Notes
NAA	10/02/15	Actor F		Notes on Actor C
	Carol
NAA	10/02/15	Actor G		Notes on A
NAA	10/02/15	Actor H		Notes on Actor D
	Ted
NA	10/02/15	Actor C		Notes on Actor E
NAA	10/02/15	Actor A		Notes on Actor F
PASS	10/02/15	Actor B		Notes on Actor H

<tbody>
</tbody>

I am thrilled it works...except....what the?!? The notes in column E do not correspond to the actor?!?

Here is the code...can you see where I've gone wrong? Could really use your help. I promise to give back when I can!

Option Explicit    Sub CastingDirector()
Dim sh As Worksheet, LR As Long, spl As Variant, i As Long, r As Long
Dim NR As Long
Dim Arange As Range
Dim x As Long
Dim BR As Long
    Set sh = Sheet4
NR = sh.Cells(Rows.Count, "E").End(xlUp).Row
    For r = NR To 6 Step -1
    If InStr(1, sh.Cells(r, 5).Value, "|") > 0 Then
         Set Arange = Range("E6:E" & NR)
         With Arange
         .Sort Key1:=Arange, Order1:=xlAscending, Header:=False
         End With
    End If
    Next
LR = sh.Cells(Rows.Count, "B").End(xlUp).Row
    For i = LR To 6 Step -1
       If sh.Cells(i, 5) Like "*|*" Then
        spl = Split(sh.Cells(i, 5).Value, "|")
        sh.Rows(i).Insert
        sh.Range("B" & i) = Trim(spl(LBound(spl)))
        With sh.Range("B" & i)
        .Font.Bold = True
        .Font.Size = 14
        End With
        sh.Range("E" & i + 1) = Trim(spl(UBound(spl)))
    End If
    Next
    BR = Range("A350").End(xlUp).Row
    For x = BR To 6 Step -1
    If Application.WorksheetFunction.CountIf(Range("B6:B" & x), Range("B" & x).Text) > 1 Then
    Range("A" & x).EntireRow.Delete
    End If
       
    Next x
End Sub

 

[RickXL]

Hi,

I can't work out what your code is supposed to do but the error is in here:

         Set Arange = Range("E6:E" & NR)
         With Arange
         .Sort Key1:=Arange, Order1:=xlAscending, Header:=False
         End With

You need to tell it both the range to sort and the key. Currently, you are telling if to sort the range Arange only.
Unfortunately, there are lots of ways to do this but I will have to pick only one - and I don't know what range you are trying to sort.

    Range("A6:E" & NR).Sort Key1:=Range("E6"), Order1:=xlAscending, Header:=False

 

[CastingDirector]

Thank you.for some reason the entire grid did not copy....but you found the issue !

 

[RickXL]

Good, I am glad you got it sorted.

Regards,