ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Finding and highlighting duplicates across multiple worksheets (https://www.excelbanter.com/excel-programming/413525-finding-highlighting-duplicates-across-multiple-worksheets.html)

vijay

Finding and highlighting duplicates across multiple worksheets
 
I basically need to be able to find and highlight duplicates across multiple
worksheets in a workbook. The highlighted duplicates must be written out to
a different blank worksheet.

I would also like to know from which worksheet the duplicate is found in.
All the data I want to compare are in columns C and D. There is another
condition that needs to be satisfied. Only compare the rows in columns C and
D when the value of of the cells in column E is "Y". There are quite a few
worksheets.

Can anyone help.

Thanks


vijay

Finding and highlighting duplicates across multiple worksheets
 
At the moment the code looks like this:

all the duplicates are written out to DUPLICATION_SHEET and am only checking
sheets whose name starts with 'Plan'.

Please correct the below code....

URGENT!!!! pretty please guys


Private Sub CheckDuplicates(ByVal strWB As Workbook, ByVal sDesc As String,
ByVal sStartCol As String, ByVal sEndCol As String)

Application.ScreenUpdating = False

Dim response As String
Dim strMsg As String
Dim intLastDataRowToCheck As Integer
Dim nRow As Integer
Dim nColumn As Integer
Dim nSourceRow As Integer
Dim bDuplicate As Boolean
Dim sFields() As String
Dim strLabel As String
Dim strOutputRec As String
Dim strParent As String
Dim strDesc As String
Dim iParent
Dim ws As Worksheet

intLastDataRowToCheck =
CInt(Worksheets(SHEET_CONTROL).Range(sRangeMaxRows ).Value)

nRow = 2

strMsg = "Click OK to run Duplicate Checks for " & sDesc
response = MsgBox(strMsg, vbOKCancel, "Run Duplicate Checks for " & sDesc)

If response = vbOK Then

Dim nCount As Integer

Dim dFlat As Object
Dim dHier As Object

Set dFlat = CreateObject("Scripting.Dictionary")
Set dHier = CreateObject("Scripting.Dictionary")

dFlat.CompareMode = vbTextCompare
dHier.CompareMode = vbTextCompare

Sheets(DUPLICATION_SHEET).Cells.Delete shift:=xlUp

'Check only Plan worksheets
For Each ws In Worksheets

Select Case ws.Name

Case "Plan Duplicates"
Case "Control"
Case "HierarchyView"
Case "Validations"
Case "Account"
Case "Entity"
Case "Custom1"
Case "Custom2"
Case "Custom3"
Case "Custom4"
Case "AppSettings"

Case Else

For nCount = intStartDataRow To intLastDataRowToCheck

'Check only rows with Extract = "Y"
If Trim(ws.Range("E" & nCount)) = "Y" Then

strParent = Trim(CStr(ws.Cells(nCount, 2).Value))
strLabel = Trim(CStr(ws.Cells(nCount, 3).Value))
strDesc = Trim(CStr(ws.Cells(nCount, 4).Value))

strOutputRec = ws.Name & DELIM_ATTR & CStr(nCount) &
DELIM_ATTR & sStartCol & DELIM_ATTR & sEndCol

If strLabel < "" Then

If Not dFlat.Exists(strLabel) Then

dFlat.Add strLabel, strOutputRec

Else

sFields = Split(dFlat(strLabel), DELIM_ATTR)
nSourceRow = CInt(sFields(COL_SOURCE_ROW))

'Check for Duplicates across worksheets

bDuplicate = False

For nColumn = ws.Range(sStartCol &
nCount).Column To ws.Range(sEndCol & nCount).Column
If ws.Cells(nSourceRow, nColumn) <
ws.Cells(nCount, nColumn) Then
bDuplicate = True
End If
Next

If bDuplicate Then
Sheets(DUPLICATION_SHEET).Range("A" &
nRow) = "Rows " & nSourceRow & ", " & nCount & " are shared nodes with
conflicting attributes in " & ws.Name & ""
Call formatValRow(DUPLICATION_SHEET, nRow)
nRow = nRow + 1
ws.Rows(nSourceRow & ":" &
nSourceRow).Copy
Sheets(DUPLICATION_SHEET).Rows(nRow &
":" & nRow).Insert shift:=xlDown
nRow = nRow + 1
ws.Rows(nCount & ":" & nCount).Copy
Sheets(DUPLICATION_SHEET).Rows(nRow &
":" & nRow).Insert shift:=xlDown
nRow = nRow + 1
End If

End If

End If

End If

Next nCount

End Select

Next ws

'Cleanup
Set dHier = Nothing
Set dFlat = Nothing

Sheets(DUPLICATION_SHEET).Select
MsgBox "Checking Duplicates Completed"

Else

MsgBox "Duplicate Checks Process Cancelled"

End If

End Sub

"Vijay" wrote:

I basically need to be able to find and highlight duplicates across multiple
worksheets in a workbook. The highlighted duplicates must be written out to
a different blank worksheet.

I would also like to know from which worksheet the duplicate is found in.
All the data I want to compare are in columns C and D. There is another
condition that needs to be satisfied. Only compare the rows in columns C and
D when the value of of the cells in column E is "Y". There are quite a few
worksheets.

Can anyone help.

Thanks


Luke Alcatel[_4_]

Finding and highlighting duplicates across multiple worksheets
 
Vijay,
Let me get this straight. First you post an appeal for someone to write
some rather simple code for you. No response, so then you post code that
you have already written and you say nothing about what doesn't work but you
ask people to correct it. Do you really expect a response? If there is
anyone who would respond to such posts, please your contact information
because I have a lot of code waiting for you to write and correct.

Luke

"Vijay" wrote in message
...
At the moment the code looks like this:

all the duplicates are written out to DUPLICATION_SHEET and am only

checking
sheets whose name starts with 'Plan'.

Please correct the below code....

URGENT!!!! pretty please guys


Private Sub CheckDuplicates(ByVal strWB As Workbook, ByVal sDesc As

String,
ByVal sStartCol As String, ByVal sEndCol As String)

Application.ScreenUpdating = False

Dim response As String
Dim strMsg As String
Dim intLastDataRowToCheck As Integer
Dim nRow As Integer
Dim nColumn As Integer
Dim nSourceRow As Integer
Dim bDuplicate As Boolean
Dim sFields() As String
Dim strLabel As String
Dim strOutputRec As String
Dim strParent As String
Dim strDesc As String
Dim iParent
Dim ws As Worksheet

intLastDataRowToCheck =
CInt(Worksheets(SHEET_CONTROL).Range(sRangeMaxRows ).Value)

nRow = 2

strMsg = "Click OK to run Duplicate Checks for " & sDesc
response = MsgBox(strMsg, vbOKCancel, "Run Duplicate Checks for " &

sDesc)

If response = vbOK Then

Dim nCount As Integer

Dim dFlat As Object
Dim dHier As Object

Set dFlat = CreateObject("Scripting.Dictionary")
Set dHier = CreateObject("Scripting.Dictionary")

dFlat.CompareMode = vbTextCompare
dHier.CompareMode = vbTextCompare

Sheets(DUPLICATION_SHEET).Cells.Delete shift:=xlUp

'Check only Plan worksheets
For Each ws In Worksheets

Select Case ws.Name

Case "Plan Duplicates"
Case "Control"
Case "HierarchyView"
Case "Validations"
Case "Account"
Case "Entity"
Case "Custom1"
Case "Custom2"
Case "Custom3"
Case "Custom4"
Case "AppSettings"

Case Else

For nCount = intStartDataRow To intLastDataRowToCheck

'Check only rows with Extract = "Y"
If Trim(ws.Range("E" & nCount)) = "Y" Then

strParent = Trim(CStr(ws.Cells(nCount, 2).Value))
strLabel = Trim(CStr(ws.Cells(nCount, 3).Value))
strDesc = Trim(CStr(ws.Cells(nCount, 4).Value))

strOutputRec = ws.Name & DELIM_ATTR & CStr(nCount)

&
DELIM_ATTR & sStartCol & DELIM_ATTR & sEndCol

If strLabel < "" Then

If Not dFlat.Exists(strLabel) Then

dFlat.Add strLabel, strOutputRec

Else

sFields = Split(dFlat(strLabel),

DELIM_ATTR)
nSourceRow = CInt(sFields(COL_SOURCE_ROW))

'Check for Duplicates across worksheets

bDuplicate = False

For nColumn = ws.Range(sStartCol &
nCount).Column To ws.Range(sEndCol & nCount).Column
If ws.Cells(nSourceRow, nColumn) <
ws.Cells(nCount, nColumn) Then
bDuplicate = True
End If
Next

If bDuplicate Then
Sheets(DUPLICATION_SHEET).Range("A" &
nRow) = "Rows " & nSourceRow & ", " & nCount & " are shared nodes with
conflicting attributes in " & ws.Name & ""
Call formatValRow(DUPLICATION_SHEET,

nRow)
nRow = nRow + 1
ws.Rows(nSourceRow & ":" &
nSourceRow).Copy
Sheets(DUPLICATION_SHEET).Rows(nRow &
":" & nRow).Insert shift:=xlDown
nRow = nRow + 1
ws.Rows(nCount & ":" & nCount).Copy
Sheets(DUPLICATION_SHEET).Rows(nRow &
":" & nRow).Insert shift:=xlDown
nRow = nRow + 1
End If

End If

End If

End If

Next nCount

End Select

Next ws

'Cleanup
Set dHier = Nothing
Set dFlat = Nothing

Sheets(DUPLICATION_SHEET).Select
MsgBox "Checking Duplicates Completed"

Else

MsgBox "Duplicate Checks Process Cancelled"

End If

End Sub

"Vijay" wrote:

I basically need to be able to find and highlight duplicates across

multiple
worksheets in a workbook. The highlighted duplicates must be written

out to
a different blank worksheet.

I would also like to know from which worksheet the duplicate is found

in.
All the data I want to compare are in columns C and D. There is another
condition that needs to be satisfied. Only compare the rows in columns C

and
D when the value of of the cells in column E is "Y". There are quite a

few
worksheets.

Can anyone help.

Thanks




vijay

Finding and highlighting duplicates across multiple worksheets
 
Hello Mr.Luke

First of all, let me thank you for posting 'your thoughts'. BTW mate, i'm
not here to post politically correct statements. The only reason i posted my
code was to give all the helpful people out there some sorta lead so that
they don't have to write any sample code (if possible). If my entire
procedure was wrong, they will certainly let me know! If you took time to
look at the size of the code, you wouldn't whinge like this. I didn't post an
entire module! It is just a simple procedure and who ever has worked in Excel
wouldn't find it difficult to correct my code.

If you are more intent on nitpicking than to help, then this is certainly
not the place for you. This is a place to share knowledge, not to fight. If
you are still keen on taking me on, i can think abt it during the weekend cos
now i don't have time for you and i have far more important things to worry
about!

Looks like you have lotsa time in your hands to post messages like these and
you can carry on if you wish but i don't give a damn! I had to write this
despite saying the above, cos people like you need to know how to behave...

Finally, Do me a favour will ya... Just don't generalise and pass on
statements! There are people out there who are more than willing to help. I
can certainly tell you are not one of 'em.

Dismiss!


"Luke Alcatel" wrote:

Vijay,
Let me get this straight. First you post an appeal for someone to write
some rather simple code for you. No response, so then you post code that
you have already written and you say nothing about what doesn't work but you
ask people to correct it. Do you really expect a response? If there is
anyone who would respond to such posts, please your contact information
because I have a lot of code waiting for you to write and correct.

Luke

"Vijay" wrote in message
...
At the moment the code looks like this:

all the duplicates are written out to DUPLICATION_SHEET and am only

checking
sheets whose name starts with 'Plan'.

Please correct the below code....

URGENT!!!! pretty please guys


Private Sub CheckDuplicates(ByVal strWB As Workbook, ByVal sDesc As

String,
ByVal sStartCol As String, ByVal sEndCol As String)

Application.ScreenUpdating = False

Dim response As String
Dim strMsg As String
Dim intLastDataRowToCheck As Integer
Dim nRow As Integer
Dim nColumn As Integer
Dim nSourceRow As Integer
Dim bDuplicate As Boolean
Dim sFields() As String
Dim strLabel As String
Dim strOutputRec As String
Dim strParent As String
Dim strDesc As String
Dim iParent
Dim ws As Worksheet

intLastDataRowToCheck =
CInt(Worksheets(SHEET_CONTROL).Range(sRangeMaxRows ).Value)

nRow = 2

strMsg = "Click OK to run Duplicate Checks for " & sDesc
response = MsgBox(strMsg, vbOKCancel, "Run Duplicate Checks for " &

sDesc)

If response = vbOK Then

Dim nCount As Integer

Dim dFlat As Object
Dim dHier As Object

Set dFlat = CreateObject("Scripting.Dictionary")
Set dHier = CreateObject("Scripting.Dictionary")

dFlat.CompareMode = vbTextCompare
dHier.CompareMode = vbTextCompare

Sheets(DUPLICATION_SHEET).Cells.Delete shift:=xlUp

'Check only Plan worksheets
For Each ws In Worksheets

Select Case ws.Name

Case "Plan Duplicates"
Case "Control"
Case "HierarchyView"
Case "Validations"
Case "Account"
Case "Entity"
Case "Custom1"
Case "Custom2"
Case "Custom3"
Case "Custom4"
Case "AppSettings"

Case Else

For nCount = intStartDataRow To intLastDataRowToCheck

'Check only rows with Extract = "Y"
If Trim(ws.Range("E" & nCount)) = "Y" Then

strParent = Trim(CStr(ws.Cells(nCount, 2).Value))
strLabel = Trim(CStr(ws.Cells(nCount, 3).Value))
strDesc = Trim(CStr(ws.Cells(nCount, 4).Value))

strOutputRec = ws.Name & DELIM_ATTR & CStr(nCount)

&
DELIM_ATTR & sStartCol & DELIM_ATTR & sEndCol

If strLabel < "" Then

If Not dFlat.Exists(strLabel) Then

dFlat.Add strLabel, strOutputRec

Else

sFields = Split(dFlat(strLabel),

DELIM_ATTR)
nSourceRow = CInt(sFields(COL_SOURCE_ROW))

'Check for Duplicates across worksheets

bDuplicate = False

For nColumn = ws.Range(sStartCol &
nCount).Column To ws.Range(sEndCol & nCount).Column
If ws.Cells(nSourceRow, nColumn) <
ws.Cells(nCount, nColumn) Then
bDuplicate = True
End If
Next

If bDuplicate Then
Sheets(DUPLICATION_SHEET).Range("A" &
nRow) = "Rows " & nSourceRow & ", " & nCount & " are shared nodes with
conflicting attributes in " & ws.Name & ""
Call formatValRow(DUPLICATION_SHEET,

nRow)
nRow = nRow + 1
ws.Rows(nSourceRow & ":" &
nSourceRow).Copy
Sheets(DUPLICATION_SHEET).Rows(nRow &
":" & nRow).Insert shift:=xlDown
nRow = nRow + 1
ws.Rows(nCount & ":" & nCount).Copy
Sheets(DUPLICATION_SHEET).Rows(nRow &
":" & nRow).Insert shift:=xlDown
nRow = nRow + 1
End If

End If

End If

End If

Next nCount

End Select

Next ws

'Cleanup
Set dHier = Nothing
Set dFlat = Nothing

Sheets(DUPLICATION_SHEET).Select
MsgBox "Checking Duplicates Completed"

Else

MsgBox "Duplicate Checks Process Cancelled"

End If

End Sub

"Vijay" wrote:

I basically need to be able to find and highlight duplicates across

multiple
worksheets in a workbook. The highlighted duplicates must be written

out to
a different blank worksheet.

I would also like to know from which worksheet the duplicate is found

in.
All the data I want to compare are in columns C and D. There is another
condition that needs to be satisfied. Only compare the rows in columns C

and
D when the value of of the cells in column E is "Y". There are quite a

few
worksheets.

Can anyone help.

Thanks





Henry Markov[_2_]

Finding and highlighting duplicates across multiple worksheets
 
Vijay,
I think Luke is trying to say that your first post (please write this code
for me ...) and your second post (here's my code please fix it ...) are not
likely (as you have seen) to elicit helpful responses. If you post code you
should at a minimum state what works and what doesn't. Usually it's best to
try to work the problem yourself at least to the point that you can say
something like "when I use X to do Y, unexpected result Z happens."

Henry

"Vijay" wrote in message
...
Hello Mr.Luke

First of all, let me thank you for posting 'your thoughts'. BTW mate, i'm
not here to post politically correct statements. The only reason i posted

my
code was to give all the helpful people out there some sorta lead so that
they don't have to write any sample code (if possible). If my entire
procedure was wrong, they will certainly let me know! If you took time to
look at the size of the code, you wouldn't whinge like this. I didn't post

an
entire module! It is just a simple procedure and who ever has worked in

Excel
wouldn't find it difficult to correct my code.

If you are more intent on nitpicking than to help, then this is certainly
not the place for you. This is a place to share knowledge, not to fight.

If
you are still keen on taking me on, i can think abt it during the weekend

cos
now i don't have time for you and i have far more important things to

worry
about!

Looks like you have lotsa time in your hands to post messages like these

and
you can carry on if you wish but i don't give a damn! I had to write this
despite saying the above, cos people like you need to know how to

behave...

Finally, Do me a favour will ya... Just don't generalise and pass on
statements! There are people out there who are more than willing to help.

I
can certainly tell you are not one of 'em.

Dismiss!


"Luke Alcatel" wrote:

Vijay,
Let me get this straight. First you post an appeal for someone to write
some rather simple code for you. No response, so then you post code

that
you have already written and you say nothing about what doesn't work but

you
ask people to correct it. Do you really expect a response? If there is
anyone who would respond to such posts, please your contact information
because I have a lot of code waiting for you to write and correct.

Luke

"Vijay" wrote in message
...
At the moment the code looks like this:

all the duplicates are written out to DUPLICATION_SHEET and am only

checking
sheets whose name starts with 'Plan'.

Please correct the below code....

URGENT!!!! pretty please guys


Private Sub CheckDuplicates(ByVal strWB As Workbook, ByVal sDesc As

String,
ByVal sStartCol As String, ByVal sEndCol As String)

Application.ScreenUpdating = False

Dim response As String
Dim strMsg As String
Dim intLastDataRowToCheck As Integer
Dim nRow As Integer
Dim nColumn As Integer
Dim nSourceRow As Integer
Dim bDuplicate As Boolean
Dim sFields() As String
Dim strLabel As String
Dim strOutputRec As String
Dim strParent As String
Dim strDesc As String
Dim iParent
Dim ws As Worksheet

intLastDataRowToCheck =
CInt(Worksheets(SHEET_CONTROL).Range(sRangeMaxRows ).Value)

nRow = 2

strMsg = "Click OK to run Duplicate Checks for " & sDesc
response = MsgBox(strMsg, vbOKCancel, "Run Duplicate Checks for "

&
sDesc)

If response = vbOK Then

Dim nCount As Integer

Dim dFlat As Object
Dim dHier As Object

Set dFlat = CreateObject("Scripting.Dictionary")
Set dHier = CreateObject("Scripting.Dictionary")

dFlat.CompareMode = vbTextCompare
dHier.CompareMode = vbTextCompare

Sheets(DUPLICATION_SHEET).Cells.Delete shift:=xlUp

'Check only Plan worksheets
For Each ws In Worksheets

Select Case ws.Name

Case "Plan Duplicates"
Case "Control"
Case "HierarchyView"
Case "Validations"
Case "Account"
Case "Entity"
Case "Custom1"
Case "Custom2"
Case "Custom3"
Case "Custom4"
Case "AppSettings"

Case Else

For nCount = intStartDataRow To intLastDataRowToCheck

'Check only rows with Extract = "Y"
If Trim(ws.Range("E" & nCount)) = "Y" Then

strParent = Trim(CStr(ws.Cells(nCount,

2).Value))
strLabel = Trim(CStr(ws.Cells(nCount,

3).Value))
strDesc = Trim(CStr(ws.Cells(nCount,

4).Value))

strOutputRec = ws.Name & DELIM_ATTR &

CStr(nCount)
&
DELIM_ATTR & sStartCol & DELIM_ATTR & sEndCol

If strLabel < "" Then

If Not dFlat.Exists(strLabel) Then

dFlat.Add strLabel, strOutputRec

Else

sFields = Split(dFlat(strLabel),

DELIM_ATTR)
nSourceRow =

CInt(sFields(COL_SOURCE_ROW))

'Check for Duplicates across

worksheets

bDuplicate = False

For nColumn = ws.Range(sStartCol &
nCount).Column To ws.Range(sEndCol & nCount).Column
If ws.Cells(nSourceRow, nColumn)

<
ws.Cells(nCount, nColumn) Then
bDuplicate = True
End If
Next

If bDuplicate Then

Sheets(DUPLICATION_SHEET).Range("A" &
nRow) = "Rows " & nSourceRow & ", " & nCount & " are shared nodes with
conflicting attributes in " & ws.Name & ""
Call

formatValRow(DUPLICATION_SHEET,
nRow)
nRow = nRow + 1
ws.Rows(nSourceRow & ":" &
nSourceRow).Copy

Sheets(DUPLICATION_SHEET).Rows(nRow &
":" & nRow).Insert shift:=xlDown
nRow = nRow + 1
ws.Rows(nCount & ":" &

nCount).Copy

Sheets(DUPLICATION_SHEET).Rows(nRow &
":" & nRow).Insert shift:=xlDown
nRow = nRow + 1
End If

End If

End If

End If

Next nCount

End Select

Next ws

'Cleanup
Set dHier = Nothing
Set dFlat = Nothing

Sheets(DUPLICATION_SHEET).Select
MsgBox "Checking Duplicates Completed"

Else

MsgBox "Duplicate Checks Process Cancelled"

End If

End Sub

"Vijay" wrote:

I basically need to be able to find and highlight duplicates across

multiple
worksheets in a workbook. The highlighted duplicates must be

written
out to
a different blank worksheet.

I would also like to know from which worksheet the duplicate is

found
in.
All the data I want to compare are in columns C and D. There is

another
condition that needs to be satisfied. Only compare the rows in

columns C
and
D when the value of of the cells in column E is "Y". There are quite

a
few
worksheets.

Can anyone help.

Thanks








All times are GMT +1. The time now is 10:04 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com