j33pguy.
Thanks for the feedback. There was definitely one error (fixed below) and I've also tried to make the irregularity check smarter. I was unable to reproduce your error involving multiple 0s, but hopefully the changes I've made will have eliminated that issue as well.
A little explanation:
What the program does, starting from the second row, is to look at a cell and the cell above it. If these two cells are the same, the program moves on to the next cell and compares it to the cell above it, etc.
However, if these to cells contain different entries, then the program checks to see if it has encountered the new value before. If no, then it stores the value in an array and moves on to the next cell. If yes, then the program considers this value a possible irregularity. To help understand which row is the causes, the irregularity checks the cell below the current one to see if that value is equal to the cell above the current one. If so, then it identifies the current cell as the possible irregularity; if not, the program identifies the cell below as the possible irregularity. Either way, the program stores the row# in a different array which is used by the form to display to the user.
You can probably see then that SOME of these irregularities are not really wrong --
For example in the case below,
row1: One
row2: One
row3: Two
row4: One
row5: Two
row6: Two
row7: Two
etc.
The program considers row 3 and 4 to be irregularities because
row3) the program identifies that Two <> One, that it has already encountered One, and that row2 = row4, signaling an irregularity
row4) the program identifies that One <> Two, that it has already encountered Two, and that row3 = row5, signaling an irregularity.
It is up to the user then to decide if row 3 or 4 is the true irregularity.
Hope that helps. Ben.
------------------------------------------------------------------------------
User this code for the Module rather than the previous:
Code:
Option Explicit
Option Base 1
Public aryError() As Integer
Public ctrError As Integer
Sub ChkIrregularities()
Dim rngData As Range
Dim aryEntry() As Variant
Dim Msg As Integer
Dim ctrC As Integer, ctrEntry As Integer, ctrNew As Integer
Set rngData = Range(Cells(1, 1), Range("A65536").End(xlUp))
ReDim aryEntry(1 To rngData.Rows.Count + 1)
ReDim aryError(1 To rngData.Rows.Count + 1)
ctrC = 1
ctrNew = 1
With rngData
aryEntry(1) = .Cells(1, 1).Value
Do
ctrC = ctrC + 1
ctrEntry = 0
If .Cells(ctrC, 1) <> .Cells(ctrC - 1) Then
If .Cells(ctrC - 1, 1) = .Cells(ctrC + 1) Then
ctrError = ctrError + 1
aryError(ctrError) = ctrC
Else
Do
ctrEntry = ctrEntry + 1
If .Cells(ctrC, 1) = aryEntry(ctrEntry) Then
ctrError = ctrError + 1
aryError(ctrError) = ctrC
End If
Loop While ctrEntry < .Rows.Count And .Cells(ctrC, 1) <> aryEntry(ctrEntry)
If .Cells(ctrC, 1) <> aryEntry(ctrEntry) Then
ctrNew = ctrNew + 1
aryEntry(ctrNew) = .Cells(ctrC, 1)
End If
End If
End If
Loop While ctrC < .Rows.Count
End With
If ctrError = 0 Then
MsgBox ("No irregularities found.")
Else
UserForm1.Show
End If
End Sub
Use this code for the UserForm rather than the previous:
Code:
Option Base 1
Private Sub UserForm_Initialize()
Dim aryOutput() As Integer
Dim ctrError As Integer
ReDim aryOutput(1 To Module1.ctrError)
UserForm1.Caption = "Possible Row Irregularities"
If Module1.ctrError = 1 Then
Label1.Caption = "There is " & Module1.ctrError & " possible irregularity."
Else
Label1.Caption = "There are " & Module1.ctrError & " possible irregularities."
End If
ListBox1.ColumnCount = 1
ctrError = 0
Do
ctrError = ctrError + 1
If Module1.aryError(ctrError) <> 0 Then
ctrOutput = ctrOutput + 1
aryOutput(ctrOutput) = Module1.aryError(ctrError)
End If
Loop While ctrError < Module1.ctrError
ListBox1.List() = aryOutput
End Sub
