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.
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]23[/TD]
[TD]1000[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]02022018092900[/TD]
[/TR]
[TR]
[TD]24[/TD]
[TD]2100[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]PG001[/TD]
[/TR]
[TR]
[TD]25[/TD]
[TD]3000[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]26[/TD]
[TD]3000[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]27[/TD]
[TD]3000[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]28[/TD]
[TD]2100[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]PG102[/TD]
[/TR]
[TR]
[TD]29[/TD]
[TD]2100[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]PG001[/TD]
[/TR]
[TR]
[TD]30[/TD]
[TD]3000[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]31[/TD]
[TD]3000[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]2[/TD]
[/TR]
</tbody>[/TABLE]



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
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG12Apr27
[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] Temp [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, R [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Const num = 2100
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & 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.Value = num [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] Temp = Dn
       [COLOR="Navy"]If[/COLOR] Not Temp [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
           [COLOR="Navy"]If[/COLOR] Not .Exists(Temp.Address) [COLOR="Navy"]Then[/COLOR]
               .Add Temp.Address, Nothing
           [COLOR="Navy"]Else[/COLOR]
               [COLOR="Navy"]If[/COLOR] .Item(Temp.Address) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
                  [COLOR="Navy"]Set[/COLOR] .Item(Temp.Address) = Dn
               [COLOR="Navy"]Else[/COLOR]
                 [COLOR="Navy"]Set[/COLOR] .Item(Temp.Address) = Union(.Item(Temp.Address), Dn)
               [COLOR="Navy"]End[/COLOR] If
           [COLOR="Navy"]End[/COLOR] If
      [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
   c = 0
    [COLOR="Navy"]If[/COLOR] Not .Item(K) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] .Item(K).Offset(, 3)
             c = c + 1
            [COLOR="Navy"]If[/COLOR] Not R.Value = c [COLOR="Navy"]Then[/COLOR]
                R.Interior.Color = vbRed
                R.Font.Color = vbYellow
                R.Font.Bold = True
          [COLOR="Navy"]End[/COLOR] If
      [COLOR="Navy"]Next[/COLOR] R
    [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
 
Upvote 0
Mick, it is very close, and this was my fault, I neglected to mention there are four (4) possible values in Column-B, 1000, 2100, 3000 and 5000. Your code worked on my test data, but it also highlighted my data line with a 5000 value in Column-B, but nothing in Column-E. I want it to ignore the 1000 and 5000 data lines if possible.

I'm going to try and look at your code and see if I can fix that issue, but I am getting a little busy now at work, so hoping you can help me correct it.

Also, I updated the range from "B2" to "B23" as that is where my data starts, but that one I get.

Appreciate the help.

Phil
 
Upvote 0
I think this might be a bit closer !!!
Code: 
[COLOR="Navy"]Sub[/COLOR] MG12Apr22
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nR [COLOR="Navy"]As[/COLOR] Range, Rng1 [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range
Const num = 2100
[COLOR="Navy"]Set[/COLOR] Rng = Range("B23", Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
   [COLOR="Navy"]If[/COLOR] Dn.Value = num [COLOR="Navy"]Then[/COLOR]
      [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] nRng
    c = 1
    [COLOR="Navy"]Do[/COLOR] [COLOR="Navy"]While[/COLOR] Dn.Offset(c) = 3000
        [COLOR="Navy"]If[/COLOR] Rng1 [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] Rng1 = Dn.Offset(c) Else [COLOR="Navy"]Set[/COLOR] Rng1 = Union(Rng1, Dn.Offset(c))
        c = c + 1
    [COLOR="Navy"]Loop[/COLOR]
 [COLOR="Navy"]Next[/COLOR] Dn
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] nR [COLOR="Navy"]In[/COLOR] Rng1.Areas
      c = 0
      [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] nR
            c = c + 1
            [COLOR="Navy"]If[/COLOR] Not R.Offset(, 3).Value = c [COLOR="Navy"]Then[/COLOR]
                R.Offset(, 3).Interior.Color = vbRed
                R.Offset(, 3).Font.Color = vbYellow
                R.Offset(, 3).Font.Bold = True
          [COLOR="Navy"]End[/COLOR] If
      [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] nR
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG, or anyone, I need to update this slightly and I'm not sure I understand your code enough to do it on my own. I need to do the same thing as stated in the original post, see the quote below, but this is updated slightly, see below the quote.

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
Click to expand...

Now, the updated portion is that the 3000 records don't have to immediately follow a 2100 record, and the 3000 records don't have to be in order.

Also, column-D, not listed above with data in it, has a unique identifier to link a 2100 and 3000 record together. So here is an updated data set.

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]23[/TD]
[TD]1000[/TD]
[TD]x[/TD]
[TD][/TD]
[TD]02022018092900[/TD]
[/TR]
[TR]
[TD]24[/TD]
[TD]2100[/TD]
[TD]x[/TD]
[TD]0001[/TD]
[TD]PG001[/TD]
[/TR]
[TR]
[TD]25[/TD]
[TD]3000[/TD]
[TD]x[/TD]
[TD]0001[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]26[/TD]
[TD]3000[/TD]
[TD]x[/TD]
[TD]0001[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]27[/TD]
[TD]3000[/TD]
[TD]x[/TD]
[TD]0001[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]28[/TD]
[TD]2100[/TD]
[TD]x[/TD]
[TD]0002[/TD]
[TD]PG102[/TD]
[/TR]
[TR]
[TD]29[/TD]
[TD]2100[/TD]
[TD]x[/TD]
[TD]0003[/TD]
[TD]PG001[/TD]
[/TR]
[TR]
[TD]30[/TD]
[TD]3000[/TD]
[TD]x[/TD]
[TD]0003[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]31[/TD]
[TD]3000[/TD]
[TD]x[/TD]
[TD]0003[/TD]
[TD]2[/TD]
[/TR]
</tbody>[/TABLE]


The records don't have to be listed like that, but the 2100 records will always precede a 3000 record.

So, I want to make sure that no 3000 record with the same unique identifier in column-D will have a duplicate value used in column-E and that the values in column-E always count up starting with 1, though they don't have to be listed in that specific order, just that if there are 3 values like on rows 25-27 in the data set above, that it has values 1, 2 & 3 in column-E for those 3000 records.


I hope that makes sense, and I hope someone can help.

Thanks,
Phil
 
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG19Sep50
[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
         nStr = "#" & Join(Application.Transpose(.Item(K).Offset(, 1)), "#") & "#"
            [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] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
I just tried it and I get an error saying Runtime error 13, Type Mistmatch, it is at this line:

Code: 
         nStr = "#" & Join(Application.Transpose(.Item(K).Offset(, 1)), "#") & "#"
 
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
492
Alex Blakenburg
A
D
  • Question Question
Find matching value in table, check if specific cell in same row is empty, find next if not
Replies
0
Views
407
dubyarly
D
H
  • Solved
Macro to sort block of data
2
Replies
15
Views
1K
Joe4
Joe4
B
  • Question Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
2
Views
565
B-radK
B
O
  • Solved
VBA Code to Find Duplicate Values in a Range and Add a Number at the End
2
Replies
12
Views
664
OilEconomist
O

Forum statistics

Threads
1,223,900
Messages
6,175,276
Members
452,629
Latest member
SahilPolekar

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