Find if data are the same in columns in a array

jbesclapez

Active Member
Joined
Feb 6, 2010
Messages
275
Hello,

I have a list from A to H.
The last row of the list is told by the last cell in column H. The data in column H is unique and always "grouped", like sorted.
The column H defines the "group" of the Answers from 1 to 7. It would probably be more clear to have column H in A, but I cannot change that... it was built like that. However... Here is below the table has it looks today (see below).


Answer1Answer2Answer3Answer4Answer5Answer6Answer7Question
03513DG44.2#68
03514DG44.2#68
03520DG44.2#68
0132705816DG44.3#69
05816DG44.3#69
05821DG44.3#69
05823DG44.3#69
11803DG44.3#69
080180790300416DG44.3#69C
0804300419DG44.3#69C
0805500420DG44.3#69C
00422DG44.3#69C
00426DG44.3#69C
DG44.3#69C
DG44.3#69C
DG44.3#69C

<tbody>
</tbody>

So from the table below, you see that :
- Question DG44.2#68 has 3 lines with a total of 3 answers.
- Question DG44.3#69 has 4 lines with a total of 5 answers.
- Question DG44.3#69C has 8 lines (some empty ones) with 9 answers.

The trick I need is that answers to any question should be unique.
I underlined a problem on question DG44.3#69 where the answers are doubled (05816).

In column I, i would like something that stops the error on the question. Like this:

EXPECTED RESULT:

Answer1Answer2Answer3Answer4Answer5Answer6Answer7Question
03513DG44.2#68
03514DG44.2#68
03520DG44.2#68
0132705816DG44.3#69Error in DG44.3#69
05816DG44.3#69
05821DG44.3#69
05823DG44.3#69
11803DG44.3#69
080180790300416DG44.3#69C
0804300419DG44.3#69C
0805500420DG44.3#69C
00422DG44.3#69C
00426DG44.3#69C
DG44.3#69C
DG44.3#69C
DG44.3#69C

<tbody>
</tbody>

Could someone create a VBA to solve that?
Please have the VBA loop, because there can be many errors in different questions.
The VBA MUST NOT touch the list. (so no "sort by", "delete" blanks...), sorry.

I hope I am clear enough.

Thanks for having a look at it!
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Try this for results in column "I".
Code:
[COLOR="Navy"]Sub[/COLOR] MG17Nov13
[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] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] dic [COLOR="Navy"]As[/COLOR] Object, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("H1"), Range("H" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]Set[/COLOR] dic = CreateObject("scripting.dictionary")
dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [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"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
[COLOR="Navy"]Set[/COLOR] nRng = .Item(K).Offset(, -7).Resize(, 6)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] nRng
        [COLOR="Navy"]If[/COLOR] Dn.Value <> "" [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] Not dic.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                dic.Add Dn.Value, Dn
            [COLOR="Navy"]Else[/COLOR]
                Range("I" & dic(Dn.Value).Row) = "Error in :- " & K
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
[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
Try this for results in column "I".
Code:
[COLOR=Navy]Sub[/COLOR] MG17Nov13
[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] K [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] dic [COLOR=Navy]As[/COLOR] Object, nRng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("H1"), Range("H" & Rows.Count).End(xlUp))
[COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=Navy]Set[/COLOR] dic = CreateObject("scripting.dictionary")
dic.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [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]Next[/COLOR]
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
[COLOR=Navy]Set[/COLOR] nRng = .Item(K).Offset(, -7).Resize(, 6)
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] nRng
        [COLOR=Navy]If[/COLOR] Dn.Value <> "" [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]If[/COLOR] Not dic.Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
                dic.Add Dn.Value, Dn
            [COLOR=Navy]Else[/COLOR]
                Range("I" & dic(Dn.Value).Row) = "Error in :- " & K
            [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]Next[/COLOR] K
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick


Hi Mick, and thanks for having a look at this.
Unfortunately the macro is not working.
If you use the data below, you will see that the macro points to an error in DIG27.1#3B but you can see that there are only unique data in this question.
Sorry. But would you mind continuing helping on that? Thanks


Answer1Answer2Answer3Answer4Answer5Answer6Answer7Question
0251511402PG 30.3#1
0251611406PG 30.3#1
11407PG 30.3#1
PG 30.3#1
PG 30.3#1
PG 30.3#1
02515CA4#2
02516CA4#2
0251503401DIG27.1#3
0251603402DIG27.1#3
03404DIG27.1#3
DIG27.1#3
DIG27.1#3
DIG27.1#3
0251503510DIG27.1#3B
0251603530DIG27.1#3B
03506DIG27.1#3B
03508DIG27.1#3B
04705DIG27.1#3B
04703DIG27.1#3B
04708DIG27.1#3B
04709DIG27.1#3B
03911DIG27.1#3B
07722DIG27.1#3B
04101DIG27.1#3B
07723DIG27.1#3B
07724DIG27.1#3B

<tbody>
</tbody>
 
Upvote 0
Sorry , Please add the line shown in red:-
NB:- The comment "Error---" in column "I" should show in the First line in each sub group where the number is duplicated.
Code:
    For Each Dn In nRng
        If Dn.Value <> "" Then
            If Not Dic.Exists(Dn.Value) Then
                Dic.Add Dn.Value, Dn
            Else
                Range("I" & Dic(Dn.Value).Row) = "Error in :- " & K
            End If
        End If
    Next Dn
[B][COLOR=#FF0000]Dic.RemoveAll[/COLOR][/B]
Next K
End With
 
Upvote 0

Forum statistics

Threads
1,213,490
Messages
6,113,957
Members
448,535
Latest member
alrossman

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