This is driving me crazy!


Posted by JAF on March 21, 2000 11:02 AM

Hiya folks.

I've been writing a macro to get a specified range from the user (using a RefEdit control on a UserForm), copying that range to a new workbook, and then automatically putting in a formula to extract the unique items (code shown below).

The macro works fine, right up to the point where I want to delete column A which contains the old copied across data, just leaving the unique items. Every time I try this, Excel crashes, but if I try from scratch on another workbook, no problem.

I can only assume that the error is caused by SOMETHING in the macro, but I can't work out what it is.

I know that I don't NEED to delete the original column, but it just looks more neat that way.

Any assistance (or suggestions as to how this might be done better - this is still version 1 of the macro!)greatly appreciated.

JAF (code follows. . .)

Private Sub OKButton_Click()
'
'Collect range from RefEdit
Dim Unique_Range As Variant
Unique_Range = RE_UniqueRange.Value
'
'If Error . . .
On Error GoTo error_trap
'
'
'
'If no error select specified range, reset RefEdit and unload UserForm
Range(Unique_Range).Select
RE_UniqueRange.Value = ""
Unload UF_UniqueItems
'
'Copy selection obtained from UserForm
Selection.Copy
'
'Add new workbook and paste values from range
Workbooks.Add
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
'
'Extract Unique Items Formula
Range("B1").Select
Selection.FormulaArray = "=IF(COUNTIF(R1C1:RC[-1],RC[-1])=1,RC[-1],""ZZZZZ"")"
'
'Copy formula down for as many rows as needed
Range("B1").Select
Do
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Loop Until ActiveCell.Offset(1, -1).Value = ""
'
'Copy formulas and paste back in as values
Columns("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
'
'Sort Data
Columns("B:B").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Replace What:="ZZZZZ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Range("B1").Select
'
'
'
'Remove the old copied in column that contains duplicates
'Commented out as THIS IS WHAT CAUSES THE ERROR
''Columns("A:A").Select
''Selection.Delete Shift:=xlToLeft
''Range("A1").Select
Exit Sub
'
error_trap:
RE_UniqueRange.Value = ""
Unload UF_UniqueItems
MsgBox "Invalid Range Specified"
End Sub



Posted by Celia on March 23, 2000 3:48 AM

JAF
I have just run your macro including the code that is causing you a problem.
The macro worked for me and did what it is supposed to do.
Celia