'Assumptions
'Database has 6 column headers starting in A1 in Sheet1
'ORG FUNDCD DOCNO JOBNO OAC OCC
'data is sorted by JOBNO in ascending order then
'FUNDCD in ascending order
'there are maximum of 2 dates per jobno

'Initial Setup
'Need to set 3 range names as follows:

'Criteria refers to range H1:H2
'Extract refers to range J1
'Database refers to =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),6)

'Copy Header JOBNO to H1 and J1

'Run the code below from a standard module

Sub RemoveDups()
Dim duprow As Long
Dim rngdb As Range
Dim rngCrit As Range
Dim rngExtract As Range
Dim RngDups As Range

Set rngCrit = Range("Criteria")
Set rngExtract = Range("Extract")
Set rngdb = Range("Database")


Range("Database").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=rngCrit, _
CopyToRange:=rngExtract, _
Unique:=True

Set RngDups = rngExtract.Offset(1, 0)

If RngDups.Value = "" Then
MsgBox "No Duplicates to remove"
Exit Sub
End If

Set RngDups = RngDups.Resize(rngExtract.End(xlDown).Row - 1, 1)

For Each cl In RngDups
duprow = WorksheetFunction.Match(cl, rngdb.Columns(4), 0)
rngdb.Rows(duprow).Delete
Set rngdb = Range("database")
Next

End Sub

Phillip wants you to use Insert|Name|Define and create a dynamic range name that
will grow/contract with the amount of data in sheet1, column A (and give it a
name DataBase).

Debra Dalgleish explains dynamic range names he
http://contextures.com/xlNames01.html#Dynamic

George Mc wrote:

Phillip,
I'm lost on the term database refers to
=OFFSET(sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),6). can you give me an example?

Thanx in advance, George

"Phillip" wrote:



'Assumptions
'Database has 6 column headers starting in A1 in Sheet1
'ORG FUNDCD DOCNO JOBNO OAC OCC
'data is sorted by JOBNO in ascending order then
'FUNDCD in ascending order
'there are maximum of 2 dates per jobno

'Initial Setup
'Need to set 3 range names as follows:

'Criteria refers to range H1:H2
'Extract refers to range J1
'Database refers to =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),6)

'Copy Header JOBNO to H1 and J1

'Run the code below from a standard module

Sub RemoveDups()
Dim duprow As Long
Dim rngdb As Range
Dim rngCrit As Range
Dim rngExtract As Range
Dim RngDups As Range

Set rngCrit = Range("Criteria")
Set rngExtract = Range("Extract")
Set rngdb = Range("Database")


Range("Database").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=rngCrit, _
CopyToRange:=rngExtract, _
Unique:=True

Set RngDups = rngExtract.Offset(1, 0)

If RngDups.Value = "" Then
MsgBox "No Duplicates to remove"
Exit Sub
End If

Set RngDups = RngDups.Resize(rngExtract.End(xlDown).Row - 1, 1)

For Each cl In RngDups
duprow = WorksheetFunction.Match(cl, rngdb.Columns(4), 0)
rngdb.Rows(duprow).Delete
Set rngdb = Range("database")
Next

End Sub



--

Dave Peterson