Hi Everyone,

I am new to excel vba programming.  I found this macro goggling.  It
basically does what I want it to do.  However, my data starts on row
6, column A.  This macro starts on A1.

I have other data above row 6 that I want to keep.  This macro messes
up the formatting.  I can't figure out how to get it to start deleting
the duplicate rows after row 6.

I tried to put a simple if statement around this statement to only do
this statement if LastRow>6.  But, I don't know if that will work
because I get syntax errors.

 .Range(.Cells(2, 1), .Cells(lLastRow, lLastCol + 2)).SpecialCells
(xlCellTypeVisible).EntireRow.Delete

Can you please help?

Usage  FilterDelete (ActiveSheet.Range("A6"))

Function FilterDelete(TargetColumn As Range)

Dim lLastRow As Long
Dim lLastCol As Long

'Check if multiple columns provided and exit if so
If TargetColumn.Columns.Count <> 1 Then Exit Function

With TargetColumn.Parent
    'Determine last row and last column
    lLastRow = .Cells.Find(What:="*", After:=.Range("A1"),
LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlPrevious).Row
    lLastCol = .Cells.Find(What:="*", After:=.Range("A1"),
LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious).Column

    'Set up an index column of ascending numbers after the last column
    .Cells(1, lLastCol + 1).Value = 1
    .Range(.Cells(2, lLastCol + 1), .Cells(lLastRow, lLastCol +
1)).FormulaR1C1 = "=R[-1]C+1"
    .Columns(lLastCol + 1).Cells.Copy
    .Columns(lLastCol + 1).Cells.PasteSpecial Paste:=xlValues

    'Sort the records by the column specified in ascending order
    .Range(.Cells(1, 1), .Cells(lLastRow, lLastCol + 1)).Sort _
        Key1:=TargetColumn, Order1:=xlAscending, _
        Key2:=.Columns(lLastCol + 1)

    'Set up an formula column at end to determine if each rows record
matches
    'the previous rows record. If so, mark it 0, otherwise 1
    .Cells(1, lLastCol + 2).Value = 0
    .Range(.Cells(2, lLastCol + 2), .Cells(lLastRow, lLastCol +
2)).FormulaR1C1 = _
        "=if(RC[" & TargetColumn.Column - (lLastCol + 2) & "]=R[-1]C["
& TargetColumn.Column - (lLastCol + 2) & "],1,0)"
    .Columns(lLastCol + 2).Cells.Copy
    .Columns(lLastCol + 2).Cells.PasteSpecial Paste:=xlValues

    'Sort the records by the match column.  Eliminates complex ranges
in large data sets that create errors
    .Range(.Cells(1, 1), .Cells(lLastRow, lLastCol + 2)).Sort _
        Key1:=.Cells(1, lLastCol + 2)

    'Autofilter and delete all cells showing a 1 as they are duplicate
values
    With .Range(.Cells(1, 1), (.Cells(lLastRow, lLastCol + 2)))

        .AutoFilter
        .AutoFilter field:=lLastCol + 2, Criteria1:="1"
    End With

    .Range(.Cells(2, 1), .Cells(lLastRow, lLastCol + 2)).SpecialCells
(xlCellTypeVisible).EntireRow.Delete

    .AutoFilterMode = False

    'Resort the data back to the original order
    .Range(.Cells(1, 1), .Cells(.Rows.Count, lLastCol + 2).End
(xlUp)).Sort _
        Key1:=.Cells(1, lLastCol + 1)

    'Remove index columns created for duplicate removal
    .Range(.Cells(1, lLastCol + 1), .Cells(1, lLastCol +
2)).EntireColumn.Delete
End With

End Function

--~--~---------~--~----~------------~-------~--~----~
----------------------------------------------------------------------------------
Some important links for excel users:
1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at 
http://www.excelitems.com
2. Excel tutorials at http://www.excel-macros.blogspot.com
3. Learn VBA Macros at http://www.vbamacros.blogspot.com
4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
 

To post to this group, send email to excel-macros@googlegroups.com
If you find any spam message in the group, please send an email to:
Ayush Jain  @ jainayus...@gmail.com or
Ashish Jain @ 26may.1...@gmail.com
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!

We reach over 6,500 subscribers worldwide and receive many nice notes about the 
learning and support from the group. Our goal is to have 10,000 subscribers by 
the end of 2009. Let friends and co-workers know they can subscribe to group at 
http://groups.google.com/group/excel-macros/subscribe
-~----------~----~----~----~------~----~------~--~---

Reply via email to