![]() |
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 |
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 |
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 |
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 |
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