ExcelBanter - Program formula Add On

Sub Sort_Move()
'
' This program has two steps, first step is it takes to tables of data and
sorts them identically.
' after this it matches cells A and E in that row to one another, if they do
not match straight across
' it inserts a cell block down of A and its corresponding cells information,
and so on and so forth until A and E equel nothing.
'
Dim rng as Range
Range("A2:D65536").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("E2:H65536").Select
Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
r = 2
10 If Cells(r, "A") = "" Or Cells(r, "E") = "" Then GoTo 99
If Cells(r, "A") = Cells(r, "E") Then r = r + 1: GoTo 10
If Cells(r, "A") < Cells(r, "E") Or Cells(r, "E") Cells(r, "A") Then
Cells(r, "E").Resize(1, 4).Select
Selection.Insert Shift:=xlDown
Set rng = Cells(r, "A").Resize(1, 4)
If Application.CountA(rng) 0 Then _
rng.Interior.ColorIndex = 6
Else
Cells(r, "A").Resize(1, 4).Select
Selection.Insert Shift:=xlDown
Set rng = Cells(r, "E").Resize(1, 4)
If Application.CountA(rng) 0 Then _
rng.Interior.ColorIndex = 6
End If
r = r + 1: GoTo 10
99
'
End Sub
'

"Sean" wrote in message
...
I have this program below, that works great right now, however I want to
tweak it a little. Currently it does what is says it does. Matchs A for
E
and if A and E dont match, it inserts them downwards along with there
corresponding cells that hold additional info on the data held in A and E.

My question is or what else I want the program to do is. When it finds a
discrepency (i.e Cells unmatched) I want it to highlight the cells in
yellow
that were wrong. Any ideas would be great, take a look at the program
below
and let me know if you have an answer to this. I spent most of my weekend
on
it and couldnt come up with a thing. Thanks to everyone that is always so
helpful.

Sub Sort_Move()
'
' This program has two steps, first step is it takes to tables of data and
sorts them identically.
' after this it matches cells A and E in that row to one another, if they
do
not match straight across
' it inserts a cell block down of A and its corresponding cells
information,
and so on and so forth until A and E equel nothing.
'
Range("A2:D65536").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("E2:H65536").Select
Selection.Sort Key1:=Range("E2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
r = 2
10 If Cells(r, "A") = "" Or Cells(r, "E") = "" Then GoTo 99
If Cells(r, "A") = Cells(r, "E") Then r = r + 1: GoTo 10
If Cells(r, "A") < Cells(r, "E") Or Cells(r, "E") Cells(r, "A")
Then
Cells(r, "E").Resize(1, 4).Select
Selection.Insert Shift:=xlDown
Else
Cells(r, "A").Resize(1, 4).Select
Selection.Insert Shift:=xlDown
End If
r = r + 1: GoTo 10
99
'