Help with an Array and Checking cell values against the array using VBA

philwojo

Well-known Member
Joined
May 10, 2013
Messages
533
OK, so I'm still messing around with trying to learn VBA stuff and getting better all the time thanks to the help from here. I'm just getting into array's and I can fill in my array values and have it be dynamic, but now I'm struggling with comparing other values to what's in the array. I'm hoping you all can help.

First, here is some sample data they are in columns b-d, they will always start at row-23, but the length of the data set can and will vary.

10001.0GAMASUA
21001.000000006
30001.000000006
30001.000000006
30001.000000006
30001.000000006
21001.000000005
30001.000000005
21001.000000003
21001.000000004
21001.000000002
30001.000000002
21001.000000000
30001.000000000
21001.000000001
30001.000000001
30001.000000003
30001.000000004
30001.000000000
50007

<tbody>
</tbody>


Here is some code I have now, keep in mind I am working on just a snippet from a larger set of code, so there are a lot of extra variables at the top of the code.

Code:
Sub TestRecordValueCheck()

'UPI = Unique Payable Identifer - from 2100 record field [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=3"]#3[/URL] 
'TPA = Total Payable Amount - from 2100 record field [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=5"]#5[/URL] 
'ITA = Invoice Total Amount - from 3000 recrod field [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=8"]#8[/URL] 
'CSPR = Count Submitted Payable Request - from 5000 record field [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=2"]#2[/URL] 
'T2100Count = A Counter for the number of time 2100 records show up
'RLN = Remittance Line number - from 3000 records field [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=4"]#4[/URL] 
'Rng = Range of the Cells to be checked

' ****************************************************************
Dim Cell As Range, Cell2 As Range, Cell3 As Range, UPI As Range, i As Integer
Dim ErrorCount As Integer, TPA As Currency, ITA As Currency, ITACell As Range, TPACell As Range
Dim CSPR As Integer, CSPRCell As Range, T2100Count As Integer
Dim RLN As Integer, RLNCell As Range, RLNCount As Integer
Dim Rng As Range, Dn As Range, nRng As Range
Dim nR As Range, Rng1 As Range, c As Long, R As Range
Dim WhatChanged As Range, CommaCount As Long, RawRNG As Range
Dim UPIVal As Range, array21(), j As Integer
Dim p As Integer, Pn As Range, Temp As Integer, Found As String
' ****************************************************************

' ****************************************************************
Set WhatChanged = Range("B2:B6000")
Const num = 2100
Set Rng = Range(Range("B23"), Range("B" & Rows.Count).End(xlUp))
Set RawRNG = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
T2100Count = 0
' ****************************************************************

' ****************************************************************
Application.EnableEvents = False
Application.ScreenUpdating = False
Worksheets("PIF Checker Output - Horz").Activate
' ****************************************************************
ErrorCount = 0
j = 1
With ThisWorkbook.Worksheets("PIF Checker Output - Horz")
  
' ****************************************************************

' ****************************************************************
    For Each Cell In Rng
        If Cell.Value = 2100 Then
            T2100Count = T2100Count + 1
        End If
    Next
    
    ReDim array21(1 To T2100Count)
    
    For Each Cell In Rng
        If Cell.Value = 2100 Then
            array21(j) = Cell.Offset(0, 2)
            j = j + 1
        End If
    Next
        
i = 1
Found = False
    For i = LBound(array21) To UBound(array21)
        If Cell.Offset(0, 2) = 3000 Then
                      
    If Found <> True Then
        ErrorCount = ErrorCount + 1
        Cell3.Offset(0, 2).Interior.Color = vbRed
        Cell3.Offset(0, 2).Font.Bold = True
        Cell3.Offset(0, 2).Font.Color = vbYellow
        Cell3.Offset(0, -1).Interior.Color = vbRed
        Cell3.Offset(0, -1).Font.Bold = True
        Cell3.Offset(0, -1).Font.Color = vbYellow
        Cell3.Offset(0, -1).Value = "Errors in this Row"
    End If
    
' ****************************************************************
End With
' ****************************************************************


Application.EnableEvents = True
Application.ScreenUpdating = True

' ****************************************************************
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

What I'm trying to do is build out an Array to contain all of the values in Column-D if the value in column-B = 2100.

Then I need to compare the values in column-D back to that array when the value in column-B = 3000.

So, from my code I am building out the array without any problems, but I'm stuck on how do I do the comparison back to the array for my values. As you can see from the sample data I can have 3000 values in different places and as stated the overall list size can change from the example. If I look at all of the 3000 values and their value in column-D doesn't show up in the Array for the 2100 values, then I want to flag that 3000 Value in column-D by changing the colors of the text and background.

I appreciate any guidance you can provide, and I'm open to suggestion on building out the array if there is a better way to do it than what I have in my code as well.

Thanks,
Phil
 
Last edited:

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
I think this should do what you want.

Code:
Sub TestRecordValueCheck()


'UPI = Unique Payable Identifer - from 2100 record field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=3]#3[/URL] 
'TPA = Total Payable Amount - from 2100 record field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=5]#5[/URL] 
'ITA = Invoice Total Amount - from 3000 recrod field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=8]#8[/URL] 
'CSPR = Count Submitted Payable Request - from 5000 record field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=2]#2[/URL] 
'T2100Count = A Counter for the number of time 2100 records show up
'RLN = Remittance Line number - from 3000 records field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=4]#4[/URL] 
'Rng = Range of the Cells to be checked


' ****************************************************************
Dim Cell As Range, Cell2 As Range, Cell3 As Range, UPI As Range, i As Integer
Dim ErrorCount As Integer, TPA As Currency, ITA As Currency, ITACell As Range, TPACell As Range
Dim CSPR As Integer, CSPRCell As Range, T2100Count As Integer
Dim RLN As Integer, RLNCell As Range, RLNCount As Integer
Dim Rng As Range, Dn As Range, nRng As Range
Dim nR As Range, Rng1 As Range, c As Long, R As Range
Dim WhatChanged As Range, CommaCount As Long, RawRNG As Range
Dim UPIVal As Range, array21(), j As Integer
Dim p As Integer, Pn As Range, Temp As Integer, Found As String
' ****************************************************************


' ****************************************************************
Set WhatChanged = Range("B2:B6000")
Const num = 2100
Set Rng = Range(Range("B23"), Range("B" & Rows.Count).End(xlUp))
Set RawRNG = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
T2100Count = 0
' ****************************************************************


' ****************************************************************
Application.EnableEvents = False
Application.ScreenUpdating = False
Worksheets("PIF Checker Output - Horz").Activate
' ****************************************************************
ErrorCount = 0
j = 1
With ThisWorkbook.Worksheets("PIF Checker Output - Horz")
  
' ****************************************************************


' ****************************************************************
    For Each Cell In Rng
        If Cell.Value = 2100 Then
            T2100Count = T2100Count + 1
        End If
    Next
    
    ReDim array21(1 To T2100Count)
    
    For Each Cell In Rng
        If Cell.Value = 2100 Then
            array21(j) = Cell.Offset(0, 2)
            j = j + 1
        End If
    Next
        
i = 1
Found = False
    For i = LBound(array21) To UBound(array21)
        For Each Cell In Rng
            If Cell.Value = 3000 Then
                If Contains(array21, Cell.Offset(0, 2).Value) Then
                    Else
                        ErrorCount = ErrorCount + 1
                        Cell.Offset(0, 2).Interior.Color = vbRed
                        Cell.Offset(0, 2).Font.Bold = True
                        Cell.Offset(0, 2).Font.Color = vbYellow
                        Cell.Offset(0, -1).Interior.Color = vbRed
                        Cell.Offset(0, -1).Font.Bold = True
                        Cell.Offset(0, -1).Font.Color = vbYellow
                        Cell.Offset(0, -1).Value = "Errors in this Row"
                End If
            End If
        Next
    Next i
' ****************************************************************
End With
' ****************************************************************




Application.EnableEvents = True
Application.ScreenUpdating = True


' ****************************************************************
Application.EnableEvents = True
Application.ScreenUpdating = True


End Sub


Function Contains(arr, v) As Boolean
Dim rv As Boolean, lb As Long, ub As Long, i As Long
    lb = LBound(arr)
    ub = UBound(arr)
    For i = lb To ub
        If arr(i) = v Then
            rv = True
            Exit For
        End If
    Next i
    Contains = rv
End Function
 
Upvote 0
Ok, so I see the Function you added at the end of my code, but as I said I'm still muddling my way through this, how does this work to do what I need, I'm a bit confused?

Code:
[COLOR=#333333]Function Contains(arr, v) As Boolean[/COLOR]Dim rv As Boolean, lb As Long, ub As Long, i As Long
    lb = LBound(arr)
    ub = UBound(arr)
    For i = lb To ub
        If arr(i) = v Then
            rv = True
            Exit For
        End If
    Next i
    Contains = rv [COLOR=#333333]End Function[/COLOR]

Thanks, and sorry if I'm just missing this one.
 
Upvote 0
Ok, so I see the Function you added at the end of my code, but as I said I'm still muddling my way through this, how does this work to do what I need, I'm a bit confused?

Code:
[COLOR=#333333]Function Contains(arr, v) As Boolean[/COLOR]Dim rv As Boolean, lb As Long, ub As Long, i As Long
    lb = LBound(arr)
    ub = UBound(arr)
    For i = lb To ub
        If arr(i) = v Then
            rv = True
            Exit For
        End If
    Next i
    Contains = rv [COLOR=#333333]End Function[/COLOR]

Thanks, and sorry if I'm just missing this one.

No problem. I already had this as a function that I use a lot so I thought you might like it for any future use. You do not have to use this method if you do not want, but having the function just makes it easier to drop into new code later on.

The function works similar to the SUM() or AVERAGE() functions already in Excel.
arr = the array you are searching through to find your value
v = the value you are searching the array for.

Sometimes functions can be faster for repetitive actions like this also. IMO

Just paste the function code after the "End Sub" of your TestRecordValueCheck Sub in the same module and the code I provided above should work.

The Function is used in this bit of code.
Code:
    For i = LBound(array21) To UBound(array21)        For Each Cell In Rng
            If Cell.Value = 3000 Then
                If Contains(array21, Cell.Offset(0, 2).Value) = False Then
                        ErrorCount = ErrorCount + 1
                        Cell.Offset(0, 2).Interior.Color = vbRed
                        Cell.Offset(0, 2).Font.Bold = True
                        Cell.Offset(0, 2).Font.Color = vbYellow
                        Cell.Offset(0, -1).Interior.Color = vbRed
                        Cell.Offset(0, -1).Font.Bold = True
                        Cell.Offset(0, -1).Font.Color = vbYellow
                        Cell.Offset(0, -1).Value = "Errors in this Row"
                End If
            End If
        Next
    Next i
 
Last edited:
Upvote 0
Ok, thanks I'm following now.

But now if I change one value in my original data set, for a 3000 value, from say ending in the ...006, to ending in ...007, meaning one that isn't in the list, I get a huge error count. It is flagging it as 15 errors, but that should only be one.

I'm starting to look at this now in the code, but wondering if you have thoughts on how to make it only count that one time?

Phil
 
Upvote 0
For the original data set I provided I would expect it to run just fine, meaning no errors would be calculated.

If I update to this data set (3rd row has changed to have a '00000007' value now, I would expect that '00000007' value to change the cell color background to red and the font to yellow/bold. I would also then expect my Error Count to produce a 1.

10001.0GAMASUA
21001.000000006
30001.000000007
30001.000000006
30001.000000006
30001.000000006
21001.000000005
30001.000000005
21001.000000003
21001.000000004
21001.000000002
30001.000000002
21001.000000000
30001.000000000
21001.000000001
30001.000000001
30001.000000003
30001.000000004
30001.000000000
50007


<tbody>
</tbody>
 
Upvote 0
For the original data set I provided I would expect it to run just fine, meaning no errors would be calculated.

If I update to this data set (3rd row has changed to have a '00000007' value now, I would expect that '00000007' value to change the cell color background to red and the font to yellow/bold. I would also then expect my Error Count to produce a 1.

10001.0GAMASUA
21001.000000006
30001.000000007
30001.000000006
30001.000000006
30001.000000006
21001.000000005
30001.000000005
21001.000000003
21001.000000004
21001.000000002
30001.000000002
21001.000000000
30001.000000000
21001.000000001
30001.000000001
30001.000000003
30001.000000004
30001.000000000
50007

<tbody>
</tbody>

Sorry I should have taken out the For Loop for the array when I added the Function. Try this.
Replace this:
Code:
[COLOR=#574123]    For i = LBound(array21) To UBound(array21)        
For Each Cell In Rng[/COLOR]            
If Cell.Value = 3000 Then
                If Contains(array21, Cell.Offset(0, 2).Value) = False Then
                        ErrorCount = ErrorCount + 1
                        Cell.Offset(0, 2).Interior.Color = vbRed
                        Cell.Offset(0, 2).Font.Bold = True
                        Cell.Offset(0, 2).Font.Color = vbYellow
                        Cell.Offset(0, -1).Interior.Color = vbRed
                        Cell.Offset(0, -1).Font.Bold = True
                        Cell.Offset(0, -1).Font.Color = vbYellow
                        Cell.Offset(0, -1).Value = "Errors in this Row"
                End If
            End If
        Next [COLOR=#574123]    Next i[/COLOR]

With This:

Code:
    For Each Cell In Rng        If Cell.Value = 3000 Then
            If Contains(array21, Cell.Offset(0, 2).Value) = False Then
                    ErrorCount = ErrorCount + 1
                    Cell.Offset(0, 2).Interior.Color = vbRed
                    Cell.Offset(0, 2).Font.Bold = True
                    Cell.Offset(0, 2).Font.Color = vbYellow
                    Cell.Offset(0, -1).Interior.Color = vbRed
                    Cell.Offset(0, -1).Font.Bold = True
                    Cell.Offset(0, -1).Font.Color = vbYellow
                    Cell.Offset(0, -1).Value = "Errors in this Row"
            End If
        End If
    Next
 
Upvote 0
Perfect, thanks for all the help.

Now I have to step myself through this to figure it out. I understand most of it, just have to spend a bit of time on the details of it.

Phil
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,916
Members
448,533
Latest member
thietbibeboiwasaco

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
Back
Top