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

j33pguy

Well-known Member
Joined
Aug 6, 2004
Messages
633
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
 

Some videos you may like

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

Glove_Man

Well-known Member
Joined
Feb 20, 2005
Messages
578
I get the impression that repeats of the identifier are allowed but that they must be in order. So only one block of each identifier. Is that true?
 

sweater_vests_rock

Well-known Member
Joined
Oct 8, 2004
Messages
1,657
j33pguy.

This code assumes that any occurrence of an identifier outside of its block is an irregularity. To run this code, be sure you have created a userform Userform1 with listbox Listbox1 and label Label1.

Copy this into the module:
Code:
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)
ReDim aryError(1 To rngData.Rows.Count)

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
            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
    Loop While ctrC < .Rows.Count
End With
                    
If ctrError = 0 Then
    MsgBox ("No irregularities found.")
Else
    UserForm1.Show
End If

End Sub

Copy this into the userform:
Code:
Option Base 1

Private Sub UserForm_Initialize()

Dim aryOutput() As Integer
Dim ctrError As Integer

ReDim aryOutput(1 To Module1.ctrError)

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

ctrError = 0
Do
    ctrError = ctrError + 1
    aryOutput(ctrError) = Module1.aryError(ctrError)
Loop While Module1.aryError(ctrError) = 0

ListBox1.List() = aryOutput

End Sub

Hope that does it for you!
Ben.
 

j33pguy

Well-known Member
Joined
Aug 6, 2004
Messages
633
that's great! thank you! that's exactly what i needed!!!! :)
one quick question though...
when there is only ONE problem in lets say row 20, the message says:
there are 2 iregularities...
and then for the row numbers it says 20 and then 0 right underneath it.....

Also, if there are more than ONE iregularities, (lets say one at row 20 and another at row 30), the message says: there are 8 iregularities... and then shows a whole bunch of 0's, then 20, and then a few more 0's!

now i think that there are 8 iregularities because the system considers everything in between those two bad datapoints, iregularities....
but what about the 0's?!

any suggestions?
 

sweater_vests_rock

Well-known Member
Joined
Oct 8, 2004
Messages
1,657

ADVERTISEMENT

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
 

sssb2000

Well-known Member
Joined
Aug 17, 2004
Messages
1,169
Ben....Great code i must say! it's very smart the way you created the logic...and yes the fix that you made fixed everything except the 0 issue.
to answer your question, YES the user will then go back to the row and decide whatever needs to be done.....
then to check it, i went back and fixed the problems. and then ran the code again...instead of showing "no irregularities", it showed a whole bunch of zeros! i'm not sure why.....
but what i have is a few numbers and words in column A....nothing fancy....and this happens everytime...no matter where i place the data

could it be that the array is not being flushed after no irregularities are found?
 

sweater_vests_rock

Well-known Member
Joined
Oct 8, 2004
Messages
1,657

ADVERTISEMENT

sssb / j33.

you're right! i didn't know this, but the userform needs to be unloaded upon exiting. use the code below (i still can't get that 0 to show...):
Code:
Option Base 1

Private Sub UserForm_Initialize()

Dim aryOutput() As Integer
Dim ctrError 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

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

Private Sub UserForm_Terminate()
Unload UserForm1
End Sub

Ben.
 

j33pguy

Well-known Member
Joined
Aug 6, 2004
Messages
633
hi sweater_vests_rock :)
i just had a follow up question regarding the help you provided me with last week.....
the code you had written worked great for column A


i was trying to make your code work with my problem and i was getting an error......see....instead of my data being in A1:A65536, my information starts in J6 and goes down....
so i tried modifying your code, but i came up with problems....i didn't know exactly what to change and what not to change....


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(6, 10), Range("j65536").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(6, 10).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


thank you for any help in advance :)
 

sweater_vests_rock

Well-known Member
Joined
Oct 8, 2004
Messages
1,657
j33pguy.

you were close! your first change to properly set the range rngData is exactly right. however, your second change on initializing the array (after the With statement) is not necessary (and i think is probably the source of the problem in absence of greater detail).

when using the With command, all of your references become relative...so
Code:
With rngData
     aryEntry(1) = .Cells(1, 1).Value
refers to the first row and first column in the RANGE, not the worksheet like Cells(1,1) would by itself.

hope that makes some sense. let me know if you continue to have problems.
ben.
 

j33pguy

Well-known Member
Joined
Aug 6, 2004
Messages
633
that makes perfect sense!
thank you so much for your patience :) you're great!
 

Watch MrExcel Video

Forum statistics

Threads
1,123,122
Messages
5,599,830
Members
414,341
Latest member
Mohammedsobhey

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top