HELP Roll Up Sheet showing only repeated data across 12 sheets

[nicolews]

Hello and Help Me Please

I have a current excel workbook that has a sheet for each month of the year. On each sheet I list branches (I'm a bank manager) that have had violation of some sort. What I need to create is a seperate Roll Up sheet that shows only branches that have had more than one violation in the year (meaning their branch name is present on more than one worksheet). Is this possible? I've watched a lot of videos about moving data to a summary page- and that I can do if the data is constant across all sheets. What I'm needing help with is only seeing the data that repeats (if it does).

*Each month may have totally different branches listed. I basically need to see the "repeat offenders" on one page. Can this be done? Help! I have a deadline to meet of 3 days.

 

[JLGWhiz]

Create a worksheet in your file named "Test". Then list your branch names, as shown in the monthly sheets, in column A without duplicates. Copy this code to the standard code module 1. See instructions at bottom of post for accessing code module. If the large pane is dark when the VBEditor opens, then click 'Insert' on the VBE menu bar, then click 'Module'. The large pane will brighten and is ready to receive the code. When the code has been installed, close the VB editor and save the file as a Macro Enabled Workbook to preserve the code when the workbook closes.

Sub repeats()
Dim sh As Worksheet, cnt As Variant
    For Each c In Sheets("Test").Range("A1", Sheets("Test").Cells(Rows.Count, 1).End(xlUp))
        For Each sh In ThisWorkbook.Sheets
            If sh.Name <> "Test" Then
                If Application.CountIf(sh.UsedRange, c.Value) > 0 Then
                    cnt = cnt + 1
                End If
            End If
        Next
        If cnt > 1 Then
            brNm = brNm & c.Value & ": " & cnt & ", "
        End If
        cnt = 0
    Next
MsgBox "The following branches have violations as indicated: " & Left(brNm, Len(brNm) - 2)
End Sub

 

[nicolews]

Thank you! I just installed the code and saved. Now what do I need to do? The test page still only has the branches listed?

 

[JLGWhiz]

Thank you! I just installed the code and saved. Now what do I need to do? The test page still only has the branches listed?

You need to run the code. See below for method to run.

 

[nicolews]

ADVERTISEMENT

I got it to work, however the below shows when I run the Macro. Is there a way to have the results populate to the test (or different) page with the whole row of information as stated in the individual months? Or is that not possible?

---------------------------
Microsoft Excel
---------------------------
The following branches have violations as indicated: 7: 6, 22: 3, 34: 2, 38: 3, 42: 2, 49: 2, 50: 4, 52: 2, 55: 2, 59: 2, 60: 3, 63: 4, 66: 4, 70: 7, 72: 6, 74: 3, 79: 2, 80: 5, 81: 3, 82: 3, 84: 2, 87: 2, 89: 2, 95: 4, 102: 5, 107: 2, 108: 2, 111: 4, 119: 2, 125: 6, 133: 2, 144: 2, 146: 3, 156: 5, 157: 2, 158: 5, 160: 2, 161: 5, 163: 5, 167: 2, 172: 4, 173: 2, 176: 2, 201: 3, 207: 2, 208: 2, 209: 2, 212: 2, 213: 3, 219: 4, 225: 3, 230: 2, 233: 2, 238: 5, 239: 4, 240: 2, 242: 2, 246: 3, 248: 2, 256: 3, 264: 2, 266: 2, 270: 3, 279: 2, 280: 3, 286: 2, 292: 3, 295: 2, 299: 2, 304: 2, 310: 5, 316: 2, 318: 2, 321: 2, 323: 3, 332: 2, 341: 2, 350: 2, 351: 3, 352: 2, 357: 2, 361: 2, 365: 2, 367: 2, 398: 3, 399: 3, 424: 2, 432: 2, 446: 3, 455: 2, 456: 2, 460: 4, 464: 3, 485: 3, 489: 2, 491: 2, 499: 4, 507: 3, 511: 3, 519: 2, 520: 3, 521: 2, 522: 3, 524: 3, 527: 2, 533: 4, 535: 3, 536: 2, 537: 3, 538: 3, 541: 3, 542: 4, 548: 3, 550: 3, 551: 3, 557: 2, 558: 2, 563: 2, 565: 2, 572: 4, 583: 2, 587: 3, 592: 2, 600: 6, 605
---------------------------
OK
---------------------------

 

[JLGWhiz]

It is helpful to have both your input and output requirements in the original post. This modified version will list the results in columns C and D Of sheet 'Test'.

Sub repeats2()
Dim sh As Worksheet, cnt As Variant
    For Each c In Sheets("Test").Range("A1", Sheets("Test").Cells(Rows.Count, 1).End(xlUp))
        For Each sh In ThisWorkbook.Sheets
            If sh.Name <> "Test" Then
                If Application.CountIf(sh.UsedRange, c.Value) > 0 Then
                    cnt = cnt + 1
                End If
            End If
        Next
        If cnt > 1 Then
            With Sheets("Test")
                If .Range("C1") = "" Then
                    .Range("C1") = "Branch"
                    .Range("D1") = "Infractions"
                End If
                .Cells(Rows.Count, 3).End(xlUp)(2) = c.Value
                .Cells(Rows.Count, 4).End(xlUp)(2) = cnt
            End With
        End If
        cnt = 0
    Next
End Sub

 

[JLGWhiz]

ADVERTISEMENT

I just re-read your post # 5 and realize that you want the entire row of data to show for each violation of each branch. To do that, I will need a better description of how your monthly sheets are laid our. ie. which columns are used for the branch ID, which columns do you want to get data from for the summary, etc. If you could post a screen shot of a page or a mock up illustration it would be helpful.

 

[JLGWhiz]

I need to know which column on the monthly sheets contains the Bank Id number, or which column contains the bank name, or both columns. Are the sheets named for the ID number or branch name?
The assumption is that only those with violations will appear on the monthly sheets, is this a true assumption?

 

[JLGWhiz]

Also, need to know if on sheet 'Test' you listed the bank ID number or Name?

 

[JLGWhiz]

Assuming that Column A of the monthly sheets have the same data type as column A of Sheets Test, this worked in a mock up test. You need to test it to see if it does what you want.

Sub repeats3()
Dim sh As Worksheet, x As Long, viol() As Variant, fn As Range, sp As Variant, i As Long, rw As Long
    For Each c In Sheets("Test").Range("A1", Sheets("Test").Cells(Rows.Count, 1).End(xlUp))
    x = 1
        For Each sh In ThisWorkbook.Sheets
            If sh.Name <> "Test" Then
                Set fn = sh.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                ReDim Preserve viol(1 To x)
                            viol(x) = sh.Name & "," & fn.Row
                            x = x + 1
                    End If
            End If
        Next
        x = 0
        If UBound(viol) > 1 Then
        rw = Sheets("Test").Cells(Rows.Count, 1).End(xlUp).Row + 1
        For i = LBound(viol) To UBound(viol)
            
            sp = Split(viol(i), ",")
            If Sheets("Test").Range("A" & rw + 1) = "" Then
                Sheets(sp(LBound(sp))).Rows(sp(UBound(sp))).Copy Sheets("Test").Cells(Rw + i, 1)
            Else
                Sheets(sp(LBound(sp))).Rows(sp(UBound(sp))).Copy Sheets("Test").Cells(Rows.Count, 1).End(xlUp)(2)
            End If
        Next
    End If
    Next
End Sub

I am doing a lot of guessing, so I need feedback if this does not work.