remove duplicates macro ending sub

S

Susan

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
 
T

Tom Ogilvy

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 said:
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
Click to expand...
 
S

Susan

put the entire macro in the general module, or just the "remove
duplicates" macro in the general?
thanks a lot for your help - i could not figure out what was wrong with
this thing.
susan
 
T

Tom Ogilvy

first, I assume this code is in a sheet module, probably fired by a
commandbutton. Because of that, you unqualified Range type references are
getting confused (my best guess base on the assumption above). So it could
be fixed by accurately qualifying these range references. The easy
alternative is to put all the code in a general/standard module (in the VBE
menu, insert=>Module).

In a general/standard Module

Sub MySub()
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

I assume you are firing this with a commandbutton so to call it:

Private Sub commandbutton1_Click()
mySub
end Sub

--
regards,
Tom Ogilvy

Susan said:
put the entire macro in the general module, or just the "remove
duplicates" macro in the general?
thanks a lot for your help - i could not figure out what was wrong with
this thing.
susan
Click to expand...
 
S

Susan

ok. i don't want to do it the easy way, i want to do it the RIGHT way
<vbg>.
so i will declare option explicit & dim all my ranges (apparently i
have "unqualified range type references" :D ).
(like i should have done in the first place.)
thanks for your help!
susan
 
T

Tom Ogilvy

Just to be a little clearer so there is no wasted work or misunderstanding:

Range("A1").Value in a general module refers to the activesheet

Range("A1").Value in a sheet module refers to the sheet containing the code

So if you had in the Sheet1 code module: (commandbutton1 on Sheet1)

Private Sub Commandbutton1_click()
worksheets("Sheet3").Select
Range("A1").Value = 10
End Sub

this would put the value 10 in Sheet1!A1 rather than Sheet3!A1 as probably
intended. the fix:

Private Sub Commandbutton1_click()
worksheets("Sheet3").Select
Activesheet.Range("A1").Value = 10
End Sub

or

Private Sub Commandbutton1_click()
worksheets("Sheet3").Select
Worksheets("Sheet3").Range("A1").Value = 10
End Sub

or

Private Sub Commandbutton1_click()
with worksheets("Sheet3")
.Select
.Range("A1").Value = 10
End with
End Sub

or - the best

Private Sub Commandbutton1_click()
worksheets("Sheet3").Range("A1").Value = 10
End Sub

So the last avoids activating sheet3 and works with it by referencing -
faster, cleaner unless you really need it to be active.

--
Regards,
Tom Ogilvy


Susan said:
ok. i don't want to do it the easy way, i want to do it the RIGHT way
<vbg>.
so i will declare option explicit & dim all my ranges (apparently i
have "unqualified range type references" :D ).
(like i should have done in the first place.)
thanks for your help!
susan
Click to expand...
 
S

Susan

well, there is no wasted work @ my level of vba experience, it's always
a learning process! however, there is a definite lack of
understanding......

so what i'm starting with now is this.... is it better?
----------------------------
Option Explicit
Sub printinsurance()

Dim ans As String
Dim MySBH As Range
Dim Insurance As Range

Set MySBH = Worksheets("FOR SBH ONLY").Range("a1:eek:100")
Set Insurance = Worksheets("Insurance").Range("a1:eek:100")

ans = MsgBox("This action will close the file without saving.
Continue?" _
, vbYesNo + vbExclamation, "Continue?")
If ans = vbNo Then Exit Sub

UserForm1.Show
Application.ScreenUpdating = False

Sheets.Add
Sheets("Sheet1").Name = "Insurance"
MySBH.Copy
Insurance.Paste
Application.CutCopyMode = False
Insurance.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
 
T

Tom Ogilvy

You set Insurance to a worksheet named insurance, then add a sheet, then
name sheet1 to be insurance - something there isn't correct.. If you just
want to add a sheet, name it insurance, and paste to A1:O100 on that sheet:

Option Explicit
Sub printinsurance()

Dim ans As String
Dim MySBH As Range
Dim Insurance As Range
Dim sh as Worksheet

Set MySBH = Worksheets("FOR SBH ONLY").Range("a1:eek:100")

ans = MsgBox("This action will close the file without saving.
Continue?" _
, vbYesNo + vbExclamation, "Continue?")
If ans = vbNo Then Exit Sub

' not sure what's going on with the Userform
UserForm1.Show

Application.ScreenUpdating = False

' delete any existing sheet named insurance
On Error
Application.DisplayAlerts = False
Worksheets("Insurance").Delete
Application.DisplayAlerts = True
On Error goto 0

' Add a new sheet and name it insurance

Worksheets.Add
Activesheet.Name = "Insurance"

' if you want to do pastespecial, just do it.

MySBH.Copy
Worksheets("Insurance").Range("A1:O100").PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
 
S

Susan

i was "dim"ing it before i inserted the new worksheet - it doesn't
exist @ the beginning of the sub. i was under the impression you
"dim"med everything in the beginning regardless of where it pops in.
the userform is basically a msgbox that says "pls wait while the macro
is running." when i started this sub i was just learning userforms &
was practicing incorporating one. i can probably change this to a msg
box now.
it seems i'm on the right track now - i worked on this more late
yesterday & will today - do you mind looking @ it again when i *think*
i've got it done?
if not, that's ok (i see you're very busy answering posts! (& probably
have a job to do, too!)) - i greatly appreciate your help.
thanks
susan
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help merging two VBA codes 2
Code to Create Chart 0
Printing Setup help 9
Macro to delete row if cells greater than certain value 1
Different Results from the Same Macro 3
VBA Pivot Table Error 1
MACRO Effeciency 3
excel macro stops 0

Top