May i ask for a little help with a VBA :-)

[j33pguy]

Hi,
i have a problem that i think VBA would be able to take care of...
i have a column (A) with unique identifiers......in the following format:

One
One
One
Two
Two
Three
Three
Three
Three
Three
.
.
.

Now, sometimes, the data in this column gets corrupted for one of many possible reasons, and what i'm left with is an identifier being repeated elsewhere!!! like this:

One
One
One
Two
Two
One
One
Three
Three
Three
.
.
.

Would it be possible for a VBA code to search through this column....and IF there is an irregularity like that, report the ROW NUMBER to the user along with an ERROR message?

Thank you so much in advance

 

[sssb2000]

i got that to work with my new range in column J but i get a very strang error when i run it.....

IF there are no irregularities, everything is fine.....it gives the message and all is well.
but if there IS an irregularity, then it says: "Method or data member not found" and it highlights ctrerror in

ReDim aryOutput(1 To Module1.ctrError)

i'm not sure why this is.....the data being checked consists of letters and numbers...for example M455948

initially i thought that i should change the type of ctrerror to STRING as oppose to Integer......but that didn't work...
any suggestions?

 

[sweater_vests_rock]

j33/sssb.

i can't seem to reproduce your error, so i'm not sure what is going on. i changed the range and the introduced/removed irregularities without a hitch. just by reading the error message, it would seem that the program cannot find Module1 (make sure your code is in the module entitled Module1) or cannot find the variable ctrError within this module (if the code is there, so is ctrError). The other possibility (although I don't see why it would give that error message) is that ctrError is not bigger than 0 or is not an integer. Even if aryOutput is not declared, I think ReDim would declare it, so I don't think that could be the issue.

maybe the best thing to try is using the below for your module code. i have updated the program to include better explanation about what each line is doing -- also, i finally was able to get the trailing 0s error, so i fixed that!

Ben.

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
Dim FirstCell As Integer

Set rngData = Range(Cells(6, 10), Range("J65536").End(xlUp))
ReDim aryEntry(1 To rngData.Rows.Count + 1)
ReDim aryError(1 To rngData.Rows.Count + 1)

'ctrC counts all entries, ctrNew counts unique entries; so, if we have (One, One, Two, Three), ctrC = 4 but ctrNew = 3
ctrC = 1
ctrNew = 1

With rngData 'Working just with the user-defined range...
    aryEntry(1) = .Cells(1, 1).Value 'Establishes initial value
    FirstCell = Right(.Cells(1, 1).Address, Len(.Cells(1, 1).Address) - InStrRev(.Cells(1, 1).Address, "$")) - 1 'Finds the Row before the fist cell in the range
    
    Do
        ctrC = ctrC + 1
        ctrEntry = 0
        
        If .Cells(ctrC, 1) <> .Cells(ctrC - 1) Then 'If the cell B is not the same as the cell before it, cell A...
            
            If .Cells(ctrC - 1, 1) = .Cells(ctrC + 1) Then 'And if cell C, the cell after B, is equal to cell A...
                ctrError = ctrError + 1 '...Then we know that there is a possible error.
                aryError(ctrError) = ctrC + FirstCell 'aryError stores the cell number (relative to the worksheet) in which the error has occurred
            Else 'If cell B is not the same as cell A, but cell A <> Cell C, we MIGHT have a unique value.  Checking this...
                
                Do 'Loop through all of the unique values we have seen thus far
                    ctrEntry = ctrEntry + 1
                    If .Cells(ctrC, 1) = aryEntry(ctrEntry) Then 'If we HAVE seen the value of Cell B before, then we have an error
                        ctrError = ctrError + 1 'We record that an error has occurred...
                        aryError(ctrError) = ctrC + FirstCell 'And we store the row number where the error occurred.
                    End If
                Loop While ctrEntry < .Rows.Count And .Cells(ctrC, 1) <> aryEntry(ctrEntry)
            
                If .Cells(ctrC, 1) <> aryEntry(ctrEntry) Then 'If we HAVEN'T seen the value of Cell B before, then it is a new unique value
                    ctrNew = ctrNew + 1 '...so we adjust ctrNew to reflect this.
                    aryEntry(ctrNew) = .Cells(ctrC, 1) 'We also add the value to our array of unique values
                End If
            
            End If
            
        End If
    
    Loop While ctrC < .Rows.Count 'We loop until the range is exhausted

End With
                    
If ctrError = 0 Then 'If we haven't found any irregularities, then we're done
    MsgBox ("No irregularities found.")
Else 'Otherwise we need to show the user where possible irregularities exist
    UserForm1.Show
End If

ctrError = 0 'This gets rid of annoying 0's if we rerun the program.

End Sub

Also, use this userform code.

Private Sub UserForm_Initialize()

Dim aryOutput() As Integer
Dim ctrErr As Integer, ctrOutput As Integer

ReDim aryOutput(1 To Module1.ctrError)
ctrOutput = 0

UserForm1.Caption = "Row Irregularities"

If Module1.ctrError = 1 Then
    Label1.Caption = "There is " & Module1.ctrError & " irregularity."
Else
    Label1.Caption = "There are " & Module1.ctrError & " irregularities."
End If

ListBox1.ColumnCount = 1

ctrErr = 0
Do
    ctrErr = ctrErr + 1
    If Module1.aryError(ctrErr) <> 0 Then
        ctrOutput = ctrOutput + 1
        aryOutput(ctrOutput) = Module1.aryError(ctrErr)
    End If
Loop While ctrErr < Module1.ctrError

ListBox1.List() = aryOutput

End Sub

Private Sub UserForm_Terminate()
Unload UserForm1
End Sub

 

[sssb2000]

Thank you
you're right....my problem was the fact that i didn't have the code in Module1 (duhh).......stupid!
i moved so many things around that i didn't pay attention to that!
one thing i noticed is that when reporting an error, the counter apparently starts from the row6 since i've told the code that my first data is in J6! so IF i have an irregularity on "ACTUAL ROW 20", it shows it on row 14! is there anyway to avoid that and make it show 20?

k.

 

[sweater_vests_rock]

sssb.

the code in my previous post should have eliminated this issue. have you tried this?

ben.

 

[sssb2000]

No, i hadn't tried it; i just did and you're right...you did take care of that issue. Also, i'm not having that 0 issue from before if you recall! thank you so very much
Have a pleasant day!