Identify the Sheet Name and Row Number of Duplicates

[RobertN]

I'm looking for a macro that will look at each cell in a specifically named column, compare it to the contents of all cells under the same named column in all other sheets, then return (in a cell in the corresponding row) the sheet name & row number where the duplicate(s) exist (there might be multiple duplicates). Something like, "Sheet Name:Row Number; Sheet Name:Row Number; Sheet Name:Row Number"

I will be using it in the attached spreadsheet, where the macro will look at each cell in the column named "Issue Key" and compare it to the contents of the "Issue Key" columns in all other sheets (more sheets may be added in the future), then populate the sheet name(s) and row number(s) (where the duplicates were found) in the corresponding rows of the columns named "Included in Other Builds"

Thanks so much for your help!

Version 11 Change Log Report.xlsx

 

[offthelip]

Try this, note you must start with the sheet you want the results in selected as the active sheet;

Sub test()
' you must start this on the sheet you want the results on
Dim dict As Object
Aname = ActiveSheet.Name
Set dict = CreateObject("scripting.dictionary")
 lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
 heads = Range(Cells(1, 1), Cells(1, lastcol))
 For j = 1 To lastcol
   If heads(1, j) = "Issue Key" Then
     icol = j
   End If
   If heads(1, j) = "Included in Other Builds" Then
     ocol = j
   End If
 Next j
If icol < 1 Or ocol < 1 Then
 MsgBox ("One or more headers missing")
 Exit Sub
End If
 lastrow = Cells(Rows.Count, icol).End(xlUp).Row
' add active sheet to dictionary
   Ary = Range(Cells(1, icol), Cells(lastrow, icol))
   For i = 2 To UBound(Ary)
      dict(Ary(i, 1)) = i    ' save original row in dictionary
   Next i
'Now loop through allthe sheets
 For shtno = 1 To Worksheets.Count
  If Worksheets(shtno).Name <> Aname Then
        With Worksheets(shtno)
             ' first find the column
             lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
             heads = .Range(.Cells(1, 1), .Cells(1, lastcol))
             For j = 1 To lastcol
               If heads(1, j) = "Issue Key" Then
                ncol = j
                Exit For
               End If
             Next j
             ' then load the dat inot an array
             lastrow = .Cells(Rows.Count, ncol).End(xlUp).Row
             inarr = .Range(.Cells(1, ncol), .Cells(lastrow, ncol))
        End With
        ' then check with te dictionary
        For i = 2 To lastrow
         If dict.Exists(inarr(i, 1)) Then
            Cells(dict(inarr(i, 1)), ocol) = Cells(dict(inarr(i, 1)), ocol) & " " & Worksheets(shtno).Name & ": Row Number " & i
         End If
        Next i
  End If
Next shtno
End Sub

 

[RobertN]

Try this, note you must start with the sheet you want the results in selected as the active sheet;

Sub test()
' you must start this on the sheet you want the results on
Dim dict As Object
Aname = ActiveSheet.Name
Set dict = CreateObject("scripting.dictionary")
 lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
 heads = Range(Cells(1, 1), Cells(1, lastcol))
 For j = 1 To lastcol
   If heads(1, j) = "Issue Key" Then
     icol = j
   End If
   If heads(1, j) = "Included in Other Builds" Then
     ocol = j
   End If
 Next j
If icol < 1 Or ocol < 1 Then
 MsgBox ("One or more headers missing")
 Exit Sub
End If
 lastrow = Cells(Rows.Count, icol).End(xlUp).Row
' add active sheet to dictionary
   Ary = Range(Cells(1, icol), Cells(lastrow, icol))
   For i = 2 To UBound(Ary)
      dict(Ary(i, 1)) = i    ' save original row in dictionary
   Next i
'Now loop through allthe sheets
 For shtno = 1 To Worksheets.Count
  If Worksheets(shtno).Name <> Aname Then
        With Worksheets(shtno)
             ' first find the column
             lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
             heads = .Range(.Cells(1, 1), .Cells(1, lastcol))
             For j = 1 To lastcol
               If heads(1, j) = "Issue Key" Then
                ncol = j
                Exit For
               End If
             Next j
             ' then load the dat inot an array
             lastrow = .Cells(Rows.Count, ncol).End(xlUp).Row
             inarr = .Range(.Cells(1, ncol), .Cells(lastrow, ncol))
        End With
        ' then check with te dictionary
        For i = 2 To lastrow
         If dict.Exists(inarr(i, 1)) Then
            Cells(dict(inarr(i, 1)), ocol) = Cells(dict(inarr(i, 1)), ocol) & " " & Worksheets(shtno).Name & ": Row Number " & i
         End If
        Next i
  End If
Next shtno
End Sub

Thank you, offthelip. I am receiving a run-time error when loading into an array. Do you know what might be causing this?

Version 11 Change Log Report.xlsm

 

[offthelip]

It could be because one of the sheets doesn't have Issue key in the column header. try making these changes:

           ' then load the dat inot an array
             If ncol > 0 Then     ' add this line
             lastrow = .Cells(Rows.Count, ncol).End(xlUp).Row
             inarr = .Range(.Cells(1, ncol), .Cells(lastrow, ncol))
             End If              ' add this line
        End With
        ' then check with te dictionary
        If ncol > 0 Then          ' add this line
        For i = 2 To lastrow
         If dict.Exists(inarr(i, 1)) Then
            Cells(dict(inarr(i, 1)), ocol) = Cells(dict(inarr(i, 1)), ocol) & " " & Worksheets(shtno).Name & ": Row Number " & i
         End If
        Next i
        End If                    ' add this line

 

[RobertN]

It could be because one of the sheets doesn't have Issue key in the column header. try making these changes:

           ' then load the dat inot an array
             If ncol > 0 Then     ' add this line
             lastrow = .Cells(Rows.Count, ncol).End(xlUp).Row
             inarr = .Range(.Cells(1, ncol), .Cells(lastrow, ncol))
             End If              ' add this line
        End With
        ' then check with te dictionary
        If ncol > 0 Then          ' add this line
        For i = 2 To lastrow
         If dict.Exists(inarr(i, 1)) Then
            Cells(dict(inarr(i, 1)), ocol) = Cells(dict(inarr(i, 1)), ocol) & " " & Worksheets(shtno).Name & ": Row Number " & i
         End If
        Next i
        End If                    ' add this line

Thanks a million! It's working beautifully

 

[offthelip]

Glad to have helped!

 

[RobertN]

Glad to have helped!

Sorry to bother you again. I've been trying to figure this out on my own with no success. I need to clear the previous results before running the script. Is there a simple one-liner that would clear all contents of the "Include in Other Builds" column (less the header/first row) in the active sheet before the rest of the script runs?

 

[offthelip]

Yes there is a simple one line to add, I have put it in the sub with the rest of down to where you need to add it:

Sub test()
' you must start this on the sheet you want the results on
Dim dict As Object
Aname = ActiveSheet.Name
Set dict = CreateObject("scripting.dictionary")
 lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
 heads = Range(Cells(1, 1), Cells(1, lastcol))
 For j = 1 To lastcol
   If heads(1, j) = "Issue Key" Then
     icol = j
   End If
   If heads(1, j) = "Included in Other Builds" Then
     ocol = j
   End If
 Next j
If icol < 1 Or ocol < 1 Then
 MsgBox ("One or more headers missing")
 Exit Sub
End If
 lastrow = Cells(Rows.Count, icol).End(xlUp).Row
 Range(Cells(2, ocol), Cells(lastrow, ocol)) = ""   ' add this line

 

[RobertN]

Yes there is a simple one line to add, I have put it in the sub with the rest of down to where you need to add it:

Sub test()
' you must start this on the sheet you want the results on
Dim dict As Object
Aname = ActiveSheet.Name
Set dict = CreateObject("scripting.dictionary")
 lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
 heads = Range(Cells(1, 1), Cells(1, lastcol))
 For j = 1 To lastcol
   If heads(1, j) = "Issue Key" Then
     icol = j
   End If
   If heads(1, j) = "Included in Other Builds" Then
     ocol = j
   End If
 Next j
If icol < 1 Or ocol < 1 Then
 MsgBox ("One or more headers missing")
 Exit Sub
End If
 lastrow = Cells(Rows.Count, icol).End(xlUp).Row
 Range(Cells(2, ocol), Cells(lastrow, ocol)) = ""   ' add this line

Thanks again!!! This is super helpful.