PDA

View Full Version : Solved: Find Duplicates



reza_doang
05-31-2010, 08:59 PM
Hi,

i have a data with many sheets from data entry (sheet1-sheet10)
now i want to find duplicates for that entry but with some condition.
I have same structure for columns (colA-colI).
now using macro i want to find duplicates with some criteria, if they have same values with colA-colE then delete it one of them or give a colors for having the same values.

many thanks...

regards,

reza

Aussiebear
05-31-2010, 09:43 PM
Just to clear this thread up a bit.

I'm assuming that you require a macro to, delete any other row, that matches in full any other row of data, across the full range of 10 sheets in the workbook. Is this correct?

Which row gets to be deleted? The first occurring or any subsequent occuring row?

reza_doang
05-31-2010, 09:49 PM
Just to clear this thread up a bit.

I'm assuming that you require a macro to, delete any other row, that matches in full any other row of data, across the full range of 10 sheets in the workbook. Is this correct?

Which row gets to be deleted? The first occurring or any subsequent occuring row?

after i think again, can you create macro but not to delete it, can you just give mark for duplicates (cell color maybe)...
but if only can delete it, good enough for me...(yes, any subsequent that occure will get delete)

thanks

GTO
05-31-2010, 10:30 PM
Hi Reza,

Rather than us recreating this, how about two example files (workbooks); one showing Before and one showing After. I do not think we need the full ten sheets, but maybe three would be a good idea.

You can zip both the Before and After wb's so that they can be posted together.

Hope that helps,

Mark

reza_doang
05-31-2010, 11:59 PM
Hi Reza,

Rather than us recreating this, how about two example files (workbooks); one showing Before and one showing After. I do not think we need the full ten sheets, but maybe three would be a good idea.

You can zip both the Before and After wb's so that they can be posted together.

Hope that helps,

Mark

so...this is my sample file.
in this file, with yellow cells mean that data are duplicates.
Duplicates can from that sheet or across the sheet, i.e in sheet1 already have that data and in sheet2 already show up.

thanks

GTO
06-01-2010, 05:05 AM
Hi there,

Try this on your example file. It is not getting the same results, as I understood that we are comparing the concatenated vals from Sheet1 to the other sheets.

In looking at the results, I am not sure. Are the rows at the bottom of each page also to be checked against the rest of the rows? Or maybe a simpller way of putting it: is each sheet to check for duplicate concatenated vals within the sheet?

In a Standard Module:


Option Explicit

Sub Main()
Dim _
wksBase As Worksheet, _
wks As Worksheet, _
rngLRow As Range, _
aryBaseRaw As Variant, _
aryBaseConcatenated As Variant, _
aryLookAtRaw As Variant, _
aryLookAtConcatenated As Variant, _
i As Long, _
x As Long, _
y As Long

Const CELL_COLOR As Long = 4

Set wksBase = ThisWorkbook.Worksheets("Sheet1")

With wksBase

Set rngLRow = RangeFound(.Range("A:E"))

aryBaseRaw = Range(.Range("A2"), .Cells(rngLRow.Row, "E")).Value

ReDim aryBaseConcatenated(1 To UBound(aryBaseRaw, 1), 1 To 1)

For x = 1 To UBound(aryBaseRaw, 1)
For y = 1 To UBound(aryBaseRaw, 2)
aryBaseConcatenated(x, 1) = aryBaseConcatenated(x, 1) & aryBaseRaw(x, y)
Next
Next
End With

For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "Sheet1" Then
With wks
Set rngLRow = RangeFound(.Range("A:E"))

aryLookAtRaw = Range(.Range("A2"), .Cells(rngLRow.Row, "E")).Value

ReDim aryLookAtConcatenated(1 To UBound(aryLookAtRaw, 1), 1 To 1)

For x = 1 To UBound(aryLookAtRaw, 1)
For y = 1 To UBound(aryBaseRaw, 2)

aryLookAtConcatenated(x, 1) = _
aryLookAtConcatenated(x, 1) & aryLookAtRaw(x, y)
Next
Next

For x = 1 To UBound(aryBaseConcatenated, 1)
For i = 1 To UBound(aryLookAtConcatenated, 1)
If aryBaseConcatenated(x, 1) = aryLookAtConcatenated(i, 1) Then

Range(wksBase.Cells(x + 1, 2), _
wksBase.Cells(x + 1, 5)) _
.Interior.ColorIndex = CELL_COLOR

Range(wks.Cells(i + 1, 2), _
wks.Cells(i + 1, 5)) _
.Interior.ColorIndex = CELL_COLOR
End If
Next
Next
End With
End If
Next
End Sub

Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

Hope this is in the right direction...

Also, when posting attachments (workbooks), please post in .xls format. I happen to be at work, but at home, cannot read 2007+ format.

Mark

reza_doang
06-01-2010, 10:47 PM
thanks mark...
i'll remind that