Hi.
In the macro above, cell A6 would be listed as:
.Cells(6,1)
Cell A1 would be shown as:
.Cells(1,1)
To keep the macro as it is but have it not sort rows before row 6 you
should change the code sections as follows:
'Set up an index column of ascending numbers after the last column
.Cells(6, lLastCol + 1).Value = 1
.Range(.Cells(7, 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(6, 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(6, lLastCol + 2).Value = 0
.Range(.Cells(7, 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(6, 1), .Cells(lLastRow, lLastCol + 2)).Sort _
Key1:=.Cells(6, lLastCol + 2)
'Autofilter and delete all cells showing a 1 as they are duplicate
values
With .Range(.Cells(6, 1), (.Cells(lLastRow, lLastCol + 2)))
.AutoFilter
.AutoFilter field:=lLastCol + 2, Criteria1:="1"
End With
.Range(.Cells(7, 1), .Cells(lLastRow, lLastCol + 2)).SpecialCells
(xlCellTypeVisible).EntireRow.Delete
.AutoFilterMode = False
'Resort the data back to the original order
.Range(.Cells(6, 1), .Cells(.Rows.Count, lLastCol + 2).End
(xlUp)).Sort _
Key1:=.Cells(6, lLastCol + 1)
Hopefully I've corrected all of the necessary lines, and if not
perhaps you can see how the macro references the cells so that you can
make any further changes yourself.
I think that the same result could also be achieved with some simpler
looking code, but I'll let the other cleverer people on the forum
demonstrate that!
Thanks
On Sep 11, 3:59 am, c <cad...@gmail.com> wrote:
> 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
-~----------~----~----~----~------~----~------~--~---
