LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,117
Default remove duplicates macro ending sub

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

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How do I remove duplicates Gazza Excel Discussion (Misc queries) 7 January 29th 10 04:33 PM
Remove Duplicates Joe Excel Worksheet Functions 2 February 13th 09 11:58 PM
remove duplicates BlindShelter Excel Discussion (Misc queries) 2 December 19th 08 08:45 PM
Remove Duplicates dk New Users to Excel 15 March 28th 08 07:41 AM
remove duplicates using vba jeff quigley Excel Programming 2 June 14th 05 07:19 PM


All times are GMT +1. The time now is 09:39 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"