If the code is in a sheet module, put it in a general module and call it from
the sheet module.

--
Regards,
Tom Ogilvy



"Susan" wrote:

i copied this section of code from
http://www.cpearson.com/excel/deleting.htm
as listed in another post, and am trying to use in in the middle of
another macro.......
it doesn't kick out an error, but after it deletes the duplicate rows
it skips
over the next section of macro (enclosed by XXX comments)
................
then it goes on & prints as commanded later in the macro.
any ideas why it is skipping over?
when i try to step through it, excel gets hung up
on the deleting columns & i have to shut the program
down....... but if i run the whole macro it doesn't get hung up.
thanks
susan
-----------------------
'THIS IS THE CODE BEFORE DELETING DUPLICATES
'IT WORKS FINE

Sheets.Add
Sheets("Sheet1").Name = "Insurance"
Sheets("FOR SBH ONLY").Select
Cells.Select
Selection.Copy
Sheets("Insurance").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False

Columns("A:A").Delete Shift:=xlToLeft
Columns("B:J").Delete Shift:=xlToLeft
Columns("D:AZ").Delete Shift:=xlToLeft
ActiveSheet.DrawingObjects.Cut

' This macro deletes duplicate rows in the selection. Duplicates are
' counted in the COLUMN of the active cell.

Dim Col As Integer
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim Rng As Range

Range("a1").Select

Application.Calculation = xlCalculationManual
Col = ActiveCell.Column

If Selection.Rows.Count 1 Then
Set Rng = Selection
Else: Set Rng = ActiveSheet.UsedRange.Rows
End If

N = 0
For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value
If Application.WorksheetFunction.CountIf _
(Rng.Columns(1), V) 1 Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If

Next r

' XXX THEN THIS IS THE PART OF THE CODE THAT DOESN'T EXECUTE

'select range & sort 1st time

Range("A6:C90").Sort Key1:=Range("A6"), Order1:=xlAscending,
Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("D6").Select

'enter formula to indicate insurance codes & autofill

ActiveCell.FormulaR1C1 = _
"=IF(ISBLANK(RC[-2]),"" "",(IF(RC[-2](TODAY()),"" "",""x"")))"
Range("D6").Select
Selection.AutoFill Destination:=Range("D6:D90"),
Type:=xlFillDefault
Range("D6:D90").Select
Selection.AutoFill Destination:=Range("D6:E90"),
Type:=xlFillDefault

'select range of autofilled columns, copy, paste values

Range("D6:E90").Select
Range("D6:E90").Select
Range("D90").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False

'select range & copy by column E, then D

Range("A6:E90").Sort Key1:=Range("E6"), Order1:=xlDescending,
Key2:=Range("D6") _
, Order2:=xlDescending, Header:=xlNo, OrderCustom:=1,
MatchCase:=False _
, Orientation:=xlTopToBottom

' XXX THEN IT PICKS UP HERE & FINISHES THE MACRO
' BELOW THIS WORKS FINE

'change page set up to portrait, fix margins, fix sheet
'headings

With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$5"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.Orientation = xlPortrait
End With

'print

ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1,
Collate _
:=True

'turn off alerts, delete the extra sheet, and
'close the window

Application.DisplayAlerts = False

Sheets("Insurance").Delete

ActiveWindow.Close

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub