Merge and Purge

[chuckwick]

I need to use Microsof excel or microsoft access to merge inj 15 different spreadsheets from various departmanets and i need to create one from the many. How do I run a loop that will search and delete duplicate records. can anyone help.

 

[Nareik]

Excel solution
This set of prcedures will analyse the range and identify duplicate unique records.
' CHuckwick - For your purposes call the suproutine DUpStatPaste with rngIn as the consodidated list.
If you leave a blank row at the top of the list, set the Headings parameter to true.

Appended to the record set you will then see 3 columns that describe the duplicate status.


Public Sub DupStatPaste(RngIn As Range, Optional HomeCell As Range, Optional Headings As Boolean)

Dim RowCnt As Long
If IsMissing(Headings) Then
Headings = False
End If

If (IsMissing(HomeCell)) Or (HomeCell Is Nothing) Then ' assume it is the cell next to the range
Set HomeCell = RngIn.Cells(1, RngIn.Columns.Count + 1)
' Set HomeCell = RngIn.Range(Cells(RngIn.Rows.Count, RngIn.Columns.Count + 1))
End If

' Initialize integer variables for the number of rows in the array.
RowCnt = RngIn.Rows.Count

With HomeCell
If Headings Then
If HomeCell.Row <> 1 Then ' not in row 1
.Offset(-1, 0).value = &quot;Dup 1, Unique 0&quot;
.Offset(-1, 1).value = &quot;Base Row&quot;
.Offset(-1, 2).value = &quot;Occurence&quot;
End If
End If
ActiveSheet.Range(.Cells(1, 1), .Cells(RowCnt, 3)).value = DupArray(RngIn, True)
End With

End Sub

Function CompareRows(rngInRange As Range, iRowA As Long, iRowB As Long, iColCount As Integer) As Boolean
' will return True if the ranges are duplicates, otherwise false
CompareRows = False ' True indicates as dup row, false indicates unique row
Dim iCheckCol As Integer
With rngInRange
For iCheckCol = 1 To iColCount
If .Cells(iRowA, iCheckCol).value = .Cells(iRowB, iCheckCol).value Then
CompareRows = True
Else
CompareRows = False
Exit Function ' there is no duplicate
End If
Next ' iCheckCol
End With
End Function

Function DupArray(rngInRange As Range, Optional bResult As Boolean) As Variant
' Depending on the bResult flag :
' True return an array containing the dup/unique flag - 0 = Unique, 1= dup, _
Base row - initial row the examined row occured in _
Occur - the occurence number of the row (the number of times it is repeated)

Application.StatusBar = &quot;&quot;
Application.DisplayStatusBar = True
Const Duplicate = 1, Unique = 0

Dim bDupFound As Boolean
Dim lInRows As Long
Dim lInCols As Integer
Dim lRowCount As Long
Dim lRowExamine As Long
Dim lOccurCount As Long

lInCols = rngInRange.Columns.Count
lInRows = rngInRange.Rows.Count
Dim aStats() As Long
ReDim aStats(lInRows, 3)

If IsMissing(bResult) Then bResult = False ' return boolean flag only
Application.DisplayStatusBar = True

For lRowCount = 1 To lInRows
If lRowCount Mod 100 = 0 Then
Application.StatusBar = &quot;Completed &quot; & Int(lRowCount / lInRows * 100) & &quot;% of duplicate analysis... &quot;
Application.DisplayStatusBar = True
End If

lOccurCount = 2
If aStats(lRowCount, 1) <> Duplicate Then
bDupFound = False

For lRowExamine = lRowCount + 1 To lInRows
If aStats(lRowExamine, 1) <> Duplicate Then
If CompareRows(rngInRange, lRowCount, lRowExamine, lInCols) Then
If Not bResult Then ' dup found exit function with bool flag only
DupArray = Duplicate
Application.StatusBar = &quot;&quot;
Exit Function ' no point in continuing after first dup is found
Else
If lOccurCount = 2 Then
aStats(lRowCount, 1) = Duplicate
aStats(lRowCount, 2) = lRowCount
aStats(lRowCount, 3) = 1
End If
aStats(lRowExamine, 1) = Duplicate
aStats(lRowExamine, 2) = lRowCount
aStats(lRowExamine, 3) = lOccurCount
bDupFound = True
lOccurCount = lOccurCount + 1
End If
End If
End If
Next ' lRowExamine

If Not bDupFound Then ' no dup, mark as unique
aStats(lRowCount, 1) = Unique
aStats(lRowCount, 2) = lRowCount
aStats(lRowCount, 3) = 1 ' as the only occurence
End If

End If
Next ' lRowCount

If bResult Then
DupArray = aStats()
Else
DupArray = False ' unique
End If
Application.StatusBar = &quot;Finished&quot;
End Function

or

Load it into access.

run the query

Select distinct * from [The consolidated list]

The resultant recordset will be non unique.

 

[PepeLeMokko]

This is for XL XP ( see the Help menu..)

Filter for unique records
Select the column or click a cell in the list you want to filter.
On the Data menu, point to Filter, and then click Advanced Filter.
Do one of the following.
To filter the list in place, similar to using AutoFilter, click Filter the list, in-place.
To copy the results of the filter to another location, click Copy to another location. Then, in the Copy To box, enter a cell reference.
To select a cell, click Collapse Dialog to temporarily hide the dialog box. Select the cell on the worksheet, and then press Expand Dialog .

Select the Unique records only check box.