VBA assistance to check values aren't duplicated for a specific block of data

P

philwojo

Well-known Member
Joined
May 10, 2013
Messages
533
Hello, I am looking for some assistance on trying to come up with some VBA code to check that an ID number isn't repeated for a particular block of data. The data block sizes can change though.

Here is a sample of the data.
BCDE
231000xx02022018092900
242100xxPG001
253000xx1
263000xx2
273000xx3
282100xxPG102
292100xxPG001
303000xx1
313000xx2

<tbody>
</tbody>



I want to make sure that any row that has a "3000" in it has a unique value. But the 3000 records are driven by and linked to the preceding 2100 record. And, as it shows in the data, a 2100 record does NOT have to have a 3000 record to go with it.

So if I find a 2100 record followed by a 3000 record I then need to look at column-E and make sure that the sequence starts with 1 and does not repeat for any 3000 record under that 2100 record. If it does, I want to highlight the cell red and turn the font a bold yellow color.

The data size can vary and it needs to be able to account for the data in column-E being consecutive, no skips or jumps in that sequence.

Thanks for any assistance.

Phil
 
Sort by date Sort by votes
Try this:-
I think the error happens when there is only one row in a particular "3000" group.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG19Sep09
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("D23", Range("D" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Dn.Offset(, -2).Value = 3000 [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                .Add Dn.Value, Dn
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
            [COLOR="Navy"]End[/COLOR] If
         [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR]

[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, R [COLOR="Navy"]As[/COLOR] Range, nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    nStr = "": c = 0
         [COLOR="Navy"]If[/COLOR] .Item(K).Count = 1 [COLOR="Navy"]Then[/COLOR]
            nStr = "#" & .Item(K).Offset(, 1).Value & "#"
         [COLOR="Navy"]Else[/COLOR]
            nStr = "#" & Join(Application.Transpose(.Item(K).Offset(, 1)), "#") & "#"
         [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] .Item(K)
              c = c + 1
              [COLOR="Navy"]If[/COLOR] InStr(nStr, "#" & c & "#") = 0 Or c = 1 And Not R.Offset(, 1).Value = 1 [COLOR="Navy"]Then[/COLOR]
                 R.Offset(, 1).Interior.Color = vbRed
                 R.Offset(, 1).Font.Color = vbYellow
                 R.Offset(, 1).Font.Bold = True
              [COLOR="Navy"]End[/COLOR] If
           [COLOR="Navy"]Next[/COLOR] R
    
    [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0

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
This is a sample of the data, this starts in column-D, row 23, and goes to column-E row 42

10001.0GAMASUA08302018143227
21001.00000000006PGIL
30001.000000000071
30001.000000000062
30001.000000000063
30001.000000000064
21001.00000000005PGIL
30001.000000000051
21001.00000000003PGIL
30001.000000000031
21001.00000000004PGIL
30001.000000000041
21001.00000000002PGIL
30001.000000000021
21001.00000000000PGIL
30001.000000000001
30001.000000000002
21001.00000000001PGIL
30001.000000000011
50007

<tbody>
</tbody>


Expected outcome would be to Highlight rows 3-6. Row-3 because the value in column-f (0000000007) does not match anything else for a 2100 line. Then rows 4-6 would be flagged because in the 4th column there is no "1" to start that data set.

Let me know if that doesn't make sense, or if you have any other questions.

This data will not be static, it will vary in type for column-D (0000000007, 0000000006, etc) and also in length. It also, as I stated previously, doesn't have to have a matching 3000 line, those are not required.

Thanks,
Phil
 
Upvote 0
MickG said:
Try this:-
I think the error happens when there is only one row in a particular "3000" group.
Code: 
[COLOR=Navy]Sub[/COLOR] MG19Sep09
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range("D23", Range("D" & Rows.Count).End(xlUp))
[COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
        [COLOR=Navy]If[/COLOR] Dn.Offset(, -2).Value = 3000 [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
                .Add Dn.Value, Dn
            [COLOR=Navy]Else[/COLOR]
                [COLOR=Navy]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
            [COLOR=Navy]End[/COLOR] If
         [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR]

[COLOR=Navy]Dim[/COLOR] K [COLOR=Navy]As[/COLOR] Variant, R [COLOR=Navy]As[/COLOR] Range, nStr [COLOR=Navy]As[/COLOR] [COLOR=Navy]String,[/COLOR] c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
    nStr = "": c = 0
         [COLOR=Navy]If[/COLOR] .Item(K).Count = 1 [COLOR=Navy]Then[/COLOR]
            nStr = "#" & .Item(K).Offset(, 1).Value & "#"
         [COLOR=Navy]Else[/COLOR]
            nStr = "#" & Join(Application.Transpose(.Item(K).Offset(, 1)), "#") & "#"
         [COLOR=Navy]End[/COLOR] If
            [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] .Item(K)
              c = c + 1
              [COLOR=Navy]If[/COLOR] InStr(nStr, "#" & c & "#") = 0 Or c = 1 And Not R.Offset(, 1).Value = 1 [COLOR=Navy]Then[/COLOR]
                 R.Offset(, 1).Interior.Color = vbRed
                 R.Offset(, 1).Font.Color = vbYellow
                 R.Offset(, 1).Font.Bold = True
              [COLOR=Navy]End[/COLOR] If
           [COLOR=Navy]Next[/COLOR] R
    
    [COLOR=Navy]Next[/COLOR] K
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...


Tried this updated code and it runs now, but it doesn't exactly do what I was hoping. I posted my expected results in my previous post. When your code ran it only highlighted (Flagged) row-26 (row-4 in my sample data) , with the 3000,1.0,0000000006,2 for the values.

I want it to flag rows 25-28 (rows 3-6 in the sample data). See my previous post if you need more details as to why.

Phil
 
Upvote 0
Try this for data starting "D23".
Code: 
[COLOR=navy]Sub[/COLOR] MG19Sep57
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Num [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] R1 [COLOR=navy]As[/COLOR] Range, R2 [COLOR=navy]As[/COLOR] Range, Q [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Set[/COLOR] Rng = Range("F23", Range("F" & Rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] Rng.Offset(, -2).Resize(, 4)
    .Interior.Color = xlNone
    .Font.Color = vbBlack
    .Font.Bold = False
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
   [COLOR=navy]If[/COLOR] Dn.Offset(, -2).Value = 2100 Or Dn.Offset(, -2).Value = 3000 [COLOR=navy]Then[/COLOR]
        Num = IIf(Dn.Offset(, -2).Value = 2100, 0, 1)
        [COLOR=navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
            
            [COLOR=navy]If[/COLOR] Dn.Offset(, -2).Value = 2100 [COLOR=navy]Then[/COLOR]
                    [COLOR=navy]Set[/COLOR] R1 = Dn.Offset(, -2)
            [COLOR=navy]ElseIf[/COLOR] Dn.Offset(, -2).Value = 3000 [COLOR=navy]Then[/COLOR]
                    [COLOR=navy]Set[/COLOR] R2 = Dn.Offset(, -2)
            [COLOR=navy]End[/COLOR] If
            .Add Dn.Value, Array(R1, R2)
        [COLOR=navy]Else[/COLOR]
            Q = .Item(Dn.Value)
                [COLOR=navy]If[/COLOR] Q(Num) [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR]
                    [COLOR=navy]Set[/COLOR] Q(Num) = Dn.Offset(, -2)
                [COLOR=navy]Else[/COLOR]
                    [COLOR=navy]Set[/COLOR] Q(Num) = Union(Q(Num), Dn.Offset(, -2))
                [COLOR=navy]End[/COLOR] If
            .Item(Dn.Value) = Q
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Set[/COLOR] R1 = Nothing: [COLOR=navy]Set[/COLOR] R2 = Nothing
[COLOR=navy]Next[/COLOR]
[COLOR=navy]Dim[/COLOR] K [COLOR=navy]As[/COLOR] Variant, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] p [COLOR=navy]As[/COLOR] Range, A [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] t, tt
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
        c = 0: A = 0
        [COLOR=navy]If[/COLOR] Not .Item(K)(0) [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR]
            A = .Item(K)(0).Count 
        [COLOR=navy]Else[/COLOR]
            A = 0
        [COLOR=navy]End[/COLOR] If
            [COLOR=navy]If[/COLOR] Not .Item(K)(1) [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR]
                [COLOR=navy]If[/COLOR] .Item(K)(0) [COLOR=navy]Is[/COLOR] Nothing Or Not .Item(K)(1)(1).Offset(, 3).Value = 1 [COLOR=navy]Then[/COLOR]
                    .Item(K)(1).Resize(, 4).Interior.Color = vbRed
                    .Item(K)(1).Resize(, 4).Font.Color = vbYellow
                    .Item(K)(1).Resize(, 4).Font.Bold = True
            [COLOR=navy]Else[/COLOR]
                    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] .Item(K)(1)
                        c = c + 1
                        [COLOR=navy]If[/COLOR] Not Dn.Offset(, 3).Value = c [COLOR=navy]Then[/COLOR]
                            Dn.Resize(, 4).Interior.Color = vbRed
                            Dn.Resize(, 4).Font.Color = vbYellow
                            Dn.Resize(, 4).Font.Bold = True
                        [COLOR=navy]End[/COLOR] If
                    [COLOR=navy]Next[/COLOR] Dn
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Mick, put in your new code and it didn't catch the issue and it turned all of the cells from D23-G41 on my test data white. There was other formatting in those cells prior to your code running. I can get that back, but not sure why your code changed it. But again, the bigger thing is it still didn't flag the errors.

i appreciate your assistance on this.

Phil
 
Upvote 0
Sorry, can you post the code in here, I can't get to sites like that from work, they have them blocked.

Phil
 
Upvote 0
Also, looking at the previous code I have from you I don't think it is looking at the correct values. You declare the RNG to start in F23, that is fine, but then you are trying to look for a value of 2100 or 300 in an offset(,-2), that only goes back to row-D.

I think I might have confused you as in post #12 I said Row-D thru Row-E at the top of that message, that should have read Row-B through Row-E, my apologizes for the typo in that post.

So my data starts in B23 and column-B is where the 2000 or 3000 values will be found.

Phil
 
Upvote 0
Try this:-
Code: 
[COLOR=navy]Sub[/COLOR] MG20Sep05
'[COLOR=green][B] Data starts "B23"[/B][/COLOR], Rng reference starts "D23"
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Num [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] R1 [COLOR=navy]As[/COLOR] Range, R2 [COLOR=navy]As[/COLOR] Range, Q [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Set[/COLOR] Rng = Range("D23", Range("D" & Rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
   [COLOR=navy]If[/COLOR] Dn.Offset(, -2).Value = 2100 Or Dn.Offset(, -2).Value = 3000 [COLOR=navy]Then[/COLOR]
        Num = IIf(Dn.Offset(, -2).Value = 2100, 0, 1)
        [COLOR=navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
            
            [COLOR=navy]If[/COLOR] Dn.Offset(, -2).Value = 2100 [COLOR=navy]Then[/COLOR]
                    [COLOR=navy]Set[/COLOR] R1 = Dn.Offset(, -2)
            [COLOR=navy]ElseIf[/COLOR] Dn.Offset(, -2).Value = 3000 [COLOR=navy]Then[/COLOR]
                    [COLOR=navy]Set[/COLOR] R2 = Dn.Offset(, -2)
            [COLOR=navy]End[/COLOR] If
            .Add Dn.Value, Array(R1, R2)
        [COLOR=navy]Else[/COLOR]
            Q = .Item(Dn.Value)
                [COLOR=navy]If[/COLOR] Q(Num) [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR]
                    [COLOR=navy]Set[/COLOR] Q(Num) = Dn.Offset(, -2)
                [COLOR=navy]Else[/COLOR]
                    [COLOR=navy]Set[/COLOR] Q(Num) = Union(Q(Num), Dn.Offset(, -2))
                [COLOR=navy]End[/COLOR] If
            .Item(Dn.Value) = Q
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Set[/COLOR] R1 = Nothing: [COLOR=navy]Set[/COLOR] R2 = Nothing
[COLOR=navy]Next[/COLOR]
[COLOR=navy]Dim[/COLOR] K [COLOR=navy]As[/COLOR] Variant, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] p [COLOR=navy]As[/COLOR] Range, A [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] t, tt
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
        c = 0: A = 0
        [COLOR=navy]If[/COLOR] Not .Item(K)(0) [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR]
            A = .Item(K)(0).Count '[COLOR=green][B]IIf(.Item(K)(0) Is Nothing, 0, .Item(K)(0).Count)[/B][/COLOR]
        [COLOR=navy]Else[/COLOR]
            A = 0
        [COLOR=navy]End[/COLOR] If
            [COLOR=navy]If[/COLOR] Not .Item(K)(1) [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR]
                [COLOR=navy]If[/COLOR] .Item(K)(0) [COLOR=navy]Is[/COLOR] Nothing Or Not .Item(K)(1)(1).Offset(, 3).Value = 1 [COLOR=navy]Then[/COLOR]
                    .Item(K)(1).Resize(, 4).Interior.Color = vbRed
                    .Item(K)(1).Resize(, 4).Font.Color = vbYellow
                    .Item(K)(1).Resize(, 4).Font.Bold = True
            [COLOR=navy]Else[/COLOR]
                    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] .Item(K)(1)
                        c = c + 1
                        [COLOR=navy]If[/COLOR] Not Dn.Offset(, 3).Value = c [COLOR=navy]Then[/COLOR]
                            Dn.Resize(, 4).Interior.Color = vbRed
                            Dn.Resize(, 4).Font.Color = vbYellow
                            Dn.Resize(, 4).Font.Bold = True
                        [COLOR=navy]End[/COLOR] If
                    [COLOR=navy]Next[/COLOR] Dn
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
OK, I'm trying to work through this as it is very close, the only thing I can't figure out is when there is an error and your do the Resize, I don't want it to highlight all 4 cells, I just want it to highlight Row-E. I tried changing the Resize to 1 (it was 4 in your code) but that moved it to column-B. I haven't really used the Resize command before.

Phil
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
VBA Check for duplicate value and change if duplicate.
Replies
7
Views
116
Alex Blakenburg
A
D
  • Question
Find matching value in table, check if specific cell in same row is empty, find next if not
Replies
0
Views
249
dubyarly
D
H
  • Solved
Macro to sort block of data
2
Replies
15
Views
970
Joe4
Joe4
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
2
Views
310
B-radK
B
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
504
AndyEd
A

Forum statistics

Threads
1,216,116
Messages
6,128,932
Members
449,480
Latest member
yesitisasport

Share this page

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