stopping a macro

[Bradly]

I have a database that contains a complete list of cases for an area. For
last month, there are approximately 15,000 cases listed; the number
fluctuates month after month. This worksheet is entitled "Cases".

I had written a macro that took all "A" cases off of that database and
listed them on a worksheet entitled "A Cases", as staff initially needed a
report to show only the "A" cases.

The need now is to list the "A" cases and any related "F" or "M" cases for
each "A" client. I am listing all of these on another sheet entitled
"Related Cases".

The process that I have come up with is this: take the first "A" cases on
the "A" sheet, paste it on the "Related Cases" sheet, and let some functions
in the next 4 rows located and list any related cases on the "Cases" sheet (I
used INDEX and MATCH functions for this). So far, it works fine.

The remainder of the process is to read the next "A" cases on the "A" sheet,
paste it on the "Related" sheet, then copy the 4 rows above that contain the
formulas. I added a loop to the code to run through the entire list on the
"A" sheet. Because the number of "A" cases varies from month to month, I
cannot tell it to loop a certain number of times--I am trying to get it to
stop when the row after the last case is blank.

All of this works fine, but I cannot get it to stop. Once the last "A" case
is pasted and the formulas are pasted beneath it, the macro continues to copy
and paste formulas to where only "#N/A" is seen on the "Related" sheet.

I would be happy to get the macro to stop right after the last case is
listed and the formulas for this last case are pasted. How can I get it to
do that? I am attaching my macro below:

Sub PlaceRelatedCases()
'
' PlaceRelatedCases Macro
'

'
Sheets("Cases").Select
Columns("A:N").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
, Order2:=xlAscending, Key3:=Range("G1"), Order3:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
Range("A1").Select
Sheets("Related Cases").Select


Sheets("A Cases").Activate
Range("A1").Select
Selection.Offset(2, 0).Range("A1:G1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Related Cases").Activate
Range("A1").Select
ActiveCell.Offset(rowOffset:=2, columnOffset:=0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("A Cases").Activate
Selection.Offset(0, 8).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Related Cases").Activate
ActiveCell.Offset(rowOffset:=0, columnOffset:=7).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("A Cases").Activate
Selection.Offset(0, 2).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Related Cases").Activate
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False


Sheets("A Cases").Activate
Selection.Offset(1, -10).Range("A1:G1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Related Cases").Activate
ActiveCell.Offset(rowOffset:=5, columnOffset:=-8).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("A Cases").Activate
Selection.Offset(0, 8).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Related Cases").Activate
ActiveCell.Offset(rowOffset:=0, columnOffset:=7).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("A Cases").Activate
Selection.Offset(0, 2).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Related Cases").Activate
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.Offset(-4, -8).Range("A1:K4").Select
Selection.Copy
ActiveCell.Offset(rowOffset:=5, columnOffset:=0).Activate
ActiveSheet.Paste


Do While Not IsEmpty(ActiveCell.Offset(0, 0))
Sheets("A Cases").Activate
Selection.Offset(1, -10).Range("A1:G1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Related Cases").Activate
ActiveCell.Offset(rowOffset:=4, columnOffset:=0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("A Cases").Activate
Selection.Offset(0, 8).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Related Cases").Activate
ActiveCell.Offset(rowOffset:=0, columnOffset:=7).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("A Cases").Activate
Selection.Offset(0, 2).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Related Cases").Activate
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.Offset(-4, -8).Range("A1:K4").Select
Selection.Copy
ActiveCell.Offset(rowOffset:=5, columnOffset:=0).Activate
ActiveSheet.Paste
Loop


Cells.Find(What:="Total Active", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End Sub

Please let me know if you need further information to understand what I am
trying to do here.
Thank you.