Thread: Recognizing, counting, and displaying duplicates

I'm sure you can see by looking at your post, it's very difficult to decipher the data as you've listed it. Posting it that way also means that if one of us is going to work on it, we have to copy everything over to get started.

Please post an example workbook.

mew!

Maybe...

Code:

Option Explicit

Private Sub CommandButton1_Click()



'Sheets("Duplicate Checking").cells(C4)
Dim Icountera As Integer
Dim Icounterb As Integer

Dim Icounterxx As Integer
Dim Icounteryy As Integer

Dim Icounterx As Integer
Dim Icountery As Integer

Dim Vcellw As Variant
Dim Vcellz As Variant

Icountera = 1
Icounterb = 2
Icounterx = 1
Icountery = 4
Icounterxx = 1
Icounteryy = 4

For Icounterxx = 1 To 7

For Icounteryy = 4 To 15

Icountera = 1


For Icounterx = 1 To 7
    
    For Icountery = 4 To 15
    
        Vcellw = Cells(Icounteryy, Icounterxx)
        Vcellz = Cells(Icountery, Icounterx)
            If Vcellw = Vcellz Then
                Icountera = Icountera + 1
            End If
                  
    Next Icountery
       
Next Icounterx

If Icountera > 1 Then
    
    Icounterx = 1
    Icountery = 1
    For Icounterx = 1 To 84
    
    If Sheets("weekly data").Cells(Icounteryy, Icounterxx) = Sheets("Duplicate Checking").Cells(2 + Icounterx, 1) Then
        Icountery = Icountery + 1
    End If
    Next Icounterx
    
    If Icountery = 1 Then
        Sheets("Duplicate Checking").Cells(1 + Icounterb, 1) = Sheets("Weekly Data").Cells(Icounteryy, Icounterxx)
        Sheets("Duplicate Checking").Cells(1 + Icounterb, 2) = Icountera - 1
        Icounterb = Icounterb + 1
    End If
End If

Next Icounteryy

Next Icounterxx

' week 2 starts here

Icountera = 1
Icounterb = 2
Icounterx = 8
Icountery = 4
Icounterxx = 8
Icounteryy = 4

For Icounterxx = 8 To 14

For Icounteryy = 4 To 15

Icountera = 1

For Icounterx = 8 To 14
    
    For Icountery = 4 To 15
    
        Vcellw = Cells(Icounteryy, Icounterxx)
        Vcellz = Cells(Icountery, Icounterx)
            If Vcellw = Vcellz Then
                Icountera = Icountera + 1
            End If
                  
    Next Icountery
       
Next Icounterx

If Icountera > 1 Then
    
    Icounterx = 1
    Icountery = 1
    For Icounterx = 1 To 84
    
    If Sheets("Weekly Data").Cells(Icounteryy, Icounterxx) = Sheets("Duplicate Checking").Cells(1 + Icounterx, 3) Then
        Icountery = Icountery + 1
    End If
    Next Icounterx
    
    If Icountery = 1 Then
        Sheets("duplicate checking").Cells(1 + Icounterb, 3) = Sheets("weekly data").Cells(Icounteryy, Icounterxx)
        Sheets("Duplicate Checking").Cells(1 + Icounterb, 4) = Icountera - 1
        Icounterb = Icounterb + 1
    End If
End If

Next Icounteryy

Next Icounterxx

' week 3 starts here

Icountera = 1
Icounterb = 2
Icounterx = 15
Icountery = 4
Icounterxx = 15
Icounteryy = 4

For Icounterxx = 15 To 21

For Icounteryy = 4 To 15

Icountera = 1

For Icounterx = 15 To 21
    
    For Icountery = 4 To 15
    
        Vcellw = Cells(Icounteryy, Icounterxx)
        Vcellz = Cells(Icountery, Icounterx)
            If Vcellw = Vcellz Then
                Icountera = Icountera + 1
            End If
                  
    Next Icountery
       
Next Icounterx

If Icountera > 1 Then
    
    Icounterx = 1
    Icountery = 1
    For Icounterx = 1 To 84
    
    If Sheets("Weekly Data").Cells(Icounteryy, Icounterxx) = Sheets("Duplicate Checking").Cells(1 + Icounterx, 5) Then
        Icountery = Icountery + 1
    End If
    Next Icounterx
    
    If Icountery = 1 Then
        Sheets("Duplicate Checking").Cells(1 + Icounterb, 5) = Sheets("Weekly Data").Cells(Icounteryy, Icounterxx)
        Sheets("Duplicate Checking").Cells(1 + Icounterb, 6) = Icountera - 1
        Icounterb = Icounterb + 1
    End If
End If

Next Icounteryy

Next Icounterxx


End Sub

Your information is the same for all three weeks, confused the hell out of me when I was trying to figure out why all three weeks worth of answers came out the same.

EDIT:
Could change this so that it looped around week to week if you have a pile more weeks worth of data, but I set it up this way cause it's easier to understand, and because you didn't say your sheet would be bigger than this.

Yup, that's VBA.

Check out the attachment, see if it returns the results correctly. I generally write this stuff in my spare time at work, so I don't have a lot of time at that point to check for possible glitches. I do however have a couple of my IM addresses linked to this site, so if you'd like a hand getting it running on your spreadsheet, feel free to send me a "mew" and I'll help you out.

mew!

EDIT:
Also please let me know if this is going to be limited to a 3 week schedule of if it needs to run for an indefinite number of weeks until encountering blanks.

mew mew!

So yeah, your welcome,
and let me know if you need anything changed on that, cause I only set it to go through three weeks worth. I could make it have one loop and loop it until there are blank cells found, but it sounded like you only needed the three weeks analyzed, so I made three loops that are all hard written in with co-ordinates.

and

I'm a kitty.
Not all kitties are ladies.

mew!

Wowzers.

K so made some revisions.

Added a counter at the beginning to determine how many weeks worth of data are present.

Cut the rest of the formula down to one loop, which increments the integers each time a loop completes, so that it goes from week to week without fixed numbers for each.

Included a couple notes in the code to hopefully make it a little clearer how it works, if you need to change anything later.

Code:

Option Explicit

Private Sub CommandButton1_Click()

'Sheets("Duplicate Checking").cells(C4)


Dim Weeks As Integer
Dim weekcount1 As Integer
Dim daycount As Integer

daycount = 0
weekcount1 = 1
Weeks = 0

' This checks for data in order to determine how many weeks are present.
' makes it run somewhat faster, there's another way to do this, but frankly,
' I still don't understand it, so I do it this way.
For weekcount1 = 1 To 100
    If Cells(4, weekcount1) > 0 Then
        daycount = daycount + 1
    End If
    If daycount = 7 Then
        Weeks = Weeks + 1
        daycount = 0
    End If
Next weekcount1
        

Dim ZZ As Integer

Dim AA As Integer
Dim BB As Integer
Dim CC As Integer
Dim DD As Integer

Dim Icountera As Integer
Dim Icounterb As Integer

Dim Icounterxx As Integer
Dim Icounteryy As Integer

Dim Icounterx As Integer
Dim Icountery As Integer

Dim Vcellw As Variant
Dim Vcellz As Variant

AA = -6
BB = 0
CC = -1
DD = 0

For ZZ = 1 To Weeks

AA = AA + 7
BB = BB + 7
CC = CC + 2
DD = DD + 2

Icountera = 1
Icounterb = 2
Icountery = 4
Icounteryy = 4

For Icounterxx = AA To BB

For Icounteryy = 4 To 15

Icountera = 1

'This is where the number of duplicates are counted.
For Icounterx = AA To BB
    
    For Icountery = 4 To 15
    
        Vcellw = Cells(Icounteryy, Icounterxx)
        Vcellz = Cells(Icountery, Icounterx)
            If Vcellw = Vcellz Then
                Icountera = Icountera + 1
            End If
                  
    Next Icountery
       
Next Icounterx

' This is where repeat listings are checked for, and where the program determines
' which cell to place numbers in.
' Changing the 1 under this paragraph will change the number of duplicates
' required for a number to be listed, IE if you only wanted instances
' higher than 3, you would change it to 4
If Icountera > 1 Then
    
    Icounterx = 1
    Icountery = 1
    For Icounterx = 1 To 84
    
    If Sheets("weekly data").Cells(Icounteryy, Icounterxx) = Sheets("Duplicate Checking").Cells(2 + Icounterx, CC) Then
        Icountery = Icountery + 1
    End If
    Next Icounterx
    
    If Icountery = 1 Then
        Sheets("Duplicate Checking").Cells(1 + Icounterb, CC) = Sheets("Weekly Data").Cells(Icounteryy, Icounterxx)
        Sheets("Duplicate Checking").Cells(1 + Icounterb, DD) = Icountera - 1
        Icounterb = Icounterb + 1
    End If
End If

Next Icounteryy

Next Icounterxx

Next ZZ

End Sub

EDIT:
There's a couple numbers in there you may have to change. There's a pair of "4 to 15" loops, those are based on the information being in rows 4 to 15. If you have information in rows farther down than that, you'll need to change the "15"s to the row number you need checked to. Also with that, there's a loop with an 84 in it. That is based on checking 84 times for a duplicate number, so if you're going to increase the number of cells copied, you'll need to increase it too.

It doesn't have to be exact, you could change the 15's and the 84 to 10000, it'd just take a lot longer to run.

There's a way to make Ranges such as those dependant upon whether or not there is information in them, I just don't really get how to do it yet.

mew.