Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
How do I remove duplicates | Excel Discussion (Misc queries) | |||
Remove Duplicates | Excel Worksheet Functions | |||
remove duplicates | Excel Discussion (Misc queries) | |||
Remove Duplicates | New Users to Excel | |||
remove duplicates using vba | Excel Programming |