Unique Combination of Values

Kishan · Dec 5, 2015

Hi, Peter

I found #post3 code very useful for me and I am using it. I want if you could adapt my need will be great of you.

I want to find unique among any of 14 columns B To O, selecting continuous or alternate 1, 2, 4, 6, or all 14
In example below I have shown 3 columns C, G, K in my selection.

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

1

Date

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

2

Date

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

3

01/12/2013

2

X

2

1

X

1

2

X

1

4

02/12/2013

2

X

1

2

1

X

2

1

2

1

2

X

5

03/12/2013

1

X

1

X

1

X

1

2

6

04/12/2013

1

2

1

2

X

1

X

1

7

05/12/2013

1

X

1

X

1

2

X

1

X

8

06/12/2013

1

2

X

1

X

1

X

9

07/12/2013

1

X

1

2

1

X

1

X

1

10

08/12/2013

1

2

1

2

1

X

1

2

11

09/12/2013

2

X

2

1

2

X

2

1

X

1

2

12

10/12/2013

X

1

2

1

2

1

X

1

13

11/12/2013

1

2

1

X

1

X

1

X

14

12/12/2013

1

2

X

2

1

2

X

1

X

2

1

15

13/12/2013

1

X

1

X

1

2

1

2

16

14/12/2013

X

1

2

1

2

X

1

17

15/12/2013

2

X

1

2

X

2

X

1

18

16/12/2013

X

1

X

1

X

1

2

19

17/12/2013

2

X

1

2

1

2

1

2

1

X

1

X

20

18/12/2013

X

1

2

1

2

1

X

2

X

2

1

21

19/12/2013

1

2

1

2

X

2

X

1

2

1

22

20/12/2013

2

1

X

2

1

X

1

X

1

2

Sheet1

I want result in sheet 2 as shown column B count match.

Book1

A

B

C

D

E

1

P2|P6|P10

Count Match

P2

P6

P10

2

X|1|1

2

X

1

3

2|1|1

3

2

1

4

1|X|1

2

1

X

1

5

1|1|1

1

6

1|X|X

1

X

7

1|1|X

1

X

8

2|1|X

2

1

X

9

1|2|2

1

2

10

1|2|1

2

1

2

1

11

X|2|1

1

X

2

1

12

X|1|2

1

X

1

2

13

2|X|2

1

2

X

2

14

1|1|2

1

2

15

1|2|X

1

2

X

Sheet2

Using Excel Version 2000

Thank You

Regards,
Kishan

Peter_SSs · Dec 5, 2015

Best to start your own thread and provide a link to the related one, rather than 'hijacking' somebody else's so I've moved your post and added the link.
In due course I will return here and see if I am able to help. Not sure at this stage.

Peter_SSs · Dec 5, 2015

Try this in a copy of your workbook.

I have assumed ..
- data starts in A1 of Sheet1 and is bounded by an empty column on the right, an empty row below & no gaps in column A dates.
- Sheet1 is active when the code is run
- you don't need to select whole columns, any cells will do. For example, selecting C5:D6, H15 and M1 will process the data for columns C, D, H and M as if those whole columns were selected.

Note, though, that my code processes the columns in the order you select them. So for your selection above, if you selected column C, then column K, then column G the results would appear in that order in Sheet2. That may be an advantage or a problem for you. If it turns out to be a problem, post back & an alternative would be offered.

Anyway, give it a go.

Rich (BB code):

Sub UniqueListAndCount()
  Dim a, vRws, vCols
  Dim d As Object
  Dim i As Long
  Dim c  As Range
  Dim s As String
  
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1
  vRws = Evaluate("Row(2:" & Range("A1").End(xlDown).Row & ")")
  ReDim vCols(0 To 0)
  For Each c In Intersect(Selection.EntireColumn, Rows(1))
    i = i + 1
    ReDim Preserve vCols(1 To i)
    vCols(i) = c.Column
  Next c
  a = Application.Index(Range("A1").CurrentRegion, vRws, vCols)
  For i = 1 To UBound(a)
    s = Join(Application.Index(a, i, 0), "|")
    If d.exists(s) Then
      d.Item(s) = d.Item(s) + 1
    Else
      d.Add s, 1
    End If
  Next i
  With Sheets("Sheet2")
    .UsedRange.ClearContents
    With .Range("A1").Resize(d.Count, 2)
      .Value = Application.Transpose(Array(d.keys, d.items))
      .Columns(1).TextToColumns Destination:=.Cells(1, 3), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|"
      .Cells(1, 2).Value = "Count Match"
    End With
  End With
End Sub

Excel Workbook

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

1

Date

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

2

Date

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

3

1/12/2013

2

X

2

1

X

1

2

X

1

4

2/12/2013

2

X

1

2

1

X

2

1

2

1

2

X

5

3/12/2013

1

X

1

X

1

X

1

2

6

4/12/2013

1

2

1

2

X

1

X

1

7

5/12/2013

1

X

1

X

1

2

X

1

X

8

6/12/2013

1

2

X

1

X

1

X

9

7/12/2013

1

X

1

2

1

X

1

X

1

10

8/12/2013

1

2

1

2

1

X

1

2

11

9/12/2013

2

X

2

1

2

X

2

1

X

1

2

12

10/12/2013

X

1

2

1

2

1

X

1

13

11/12/2013

1

2

1

X

1

X

1

X

14

12/12/2013

1

2

X

2

1

2

X

1

X

2

1

15

13/12/2013

1

X

1

X

1

2

1

2

16

14/12/2013

X

1

2

1

2

X

1

17

15/12/2013

2

X

1

2

X

2

X

1

18

16/12/2013

X

1

X

1

X

1

2

19

17/12/2013

2

X

1

2

1

2

1

2

1

X

1

X

20

18/12/2013

X

1

2

1

2

1

X

2

X

2

1

21

19/12/2013

1

2

1

2

X

2

X

1

2

1

22

20/12/2013

2

1

X

2

1

X

1

X

1

2

23

Sheet1

With those green cells selected as described above, these are my results:

Peter_SSs · Dec 5, 2015

I wasn't able to post this image in my last post, so here it is.

Excel Workbook

A

B

C

D

E

F

G

1

P2|P3|P7|P12

Count Match

P2

P3

P7

P12

2

X|2|X|X

1

X

2

X

3

2|X|X|1

1

2

X

1

4

1|1|1|X

1

X

5

1|1|1|1

3

1

6

X|1|2|1

1

X

1

2

1

7

1|X|1|1

1

X

1

8

2|1|2|1

1

2

1

2

1

9

2|X|2|X

1

2

X

2

X

10

1|1|2|X

1

2

X

11

2|1|1|1

1

2

1

12

1|2|1|X

1

2

1

X

13

X|1|2|2

1

X

1

2

14

X|1|1|1

1

X

1

15

2|2|1|2

1

2

1

2

16

1|1|X|1

1

X

1

17

2|X|2|1

1

2

X

2

1

18

1|1|2|2

1

2

19

1|1|X|2

1

X

2

20

Sheet2

Kishan · Dec 6, 2015

Peter_SSs said:
Best to start your own thread and provide a link to the related one

Hi Peter,
Sorry for my ignorance. Thank you... next time I will follow your instructions

Peter_SSs said:
Try this in a copy of your workbook.

I have assumed ..
- data starts in A1 of Sheet1 and is bounded by an empty column on the right, an empty row below & no gaps in column A dates.
- Sheet1 is active when the code is run
- you don't need to select whole columns, any cells will do. For example, selecting C5:D6, H15 and M1 will process the data for columns C, D, H and M as if those whole columns were selected.

Note, though, that my code processes the columns in the order you select them. So for your selection above, if you selected column C, then column K, then column G the results would appear in that order in Sheet2. That may be an advantage or a problem for you. If it turns out to be a problem, post back & an alternative would be offered.

Anyway, give it a go.

Thank you Peter, for giving a key solution it is working superbly!!

Selecting process of columns I find very clever, also it is fine that code processes the columns in the order as select them.

Thank you once again for your kind help

Regards,
Kishan

Peter_SSs · Dec 6, 2015

Kishan said:
Thank you Peter, for giving a key solution it is working superbly!!

Selecting process of columns I find very clever, also it is fine that code processes the columns in the order as select them.

Thank you once again for your kind help

Regards,
Kishan

You are welcome. Glad you liked it.

Rick Rothstein · Dec 6, 2015

Peter_SSs said:
You are welcome. Glad you liked it.

I had trouble running your code with a test layout of 56000 rows (the OP's original 20 rows of data repeated to fill the 56000 rows)... it raised a "Subscript out of range" error on this line of code...

vCols(i) = c.Column

I am not sure why as that line looks correct... could it have something to do with the number of rows of data being processed? The reason I tried to run your code was I wanted to time test it against the code I developed below. With all 15 columns selected (I figured that would produce the longest run timesJ), it processes the 56000 rows of data in 0.88 seconds. I was wondering if the Dictionary approach would be faster or not. Anyway, here is the code I came up with...

Code:

[table="width: 500"]
[tr]
	[td]Sub UniqueListAndCountToo()
  Dim X As Long, LastRow As Long, Addr As String, Data As Variant, CountMatch As Variant
  LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
  For X = 2 To 15
    If Not Intersect(Selection.EntireColumn, Cells(1, X)) Is Nothing Then Addr = Addr & "&""|""&" & Cells(1, X).Resize(LastRow).Address(0, 0)
  Next
  Addr = Mid(Addr, 6)
  With Sheets("Sheet2")
    .UsedRange.Clear
    Data = Evaluate(Addr)
    .Range("A1").Resize(Cells(Rows.Count, "A").End(xlUp).Row) = Data
    .Columns("A").RemoveDuplicates Columns:=1, Header:=xlNo
    .Range("A1", .Cells(Rows.Count, "A").End(xlUp)).TextToColumns Range("C1"), xlDelimited, , , 0, 0, 0, 0, True, "|"
    .Range("B1").Value = "Count Match"
    Data = WorksheetFunction.Transpose(Data)
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    ReDim CountMatch(1 To LastRow - 1, 1 To 1)
    For X = 2 To LastRow
      CountMatch(X - 1, 1) = 1 + UBound(Filter(Data, .Cells(X, "A").Value))
    Next
    .Range("B2").Resize(UBound(CountMatch)) = CountMatch
    With .Columns("A").Resize(, .Cells(1, Columns.Count).End(xlToLeft).Column)
      .AutoFit
      .HorizontalAlignment = xlCenter
    End With
  End With
End Sub[/td]
[/tr]
[/table]

Rick Rothstein · Dec 6, 2015

Rick Rothstein said:
I had trouble running your code with a test layout of 56000 rows (the OP's original 20 rows of data repeated to fill the 56000 rows)... it raised a "Subscript out of range" error on this line of code...

vCols(i) = c.Column

I am not sure why as that line looks correct... could it have something to do with the number of rows of data being processed? The reason I tried to run your code was I wanted to time test it against the code I developed below. With all 15 columns selected (I figured that would produce the longest run timesJ), it processes the 56000 rows of data in 0.88 seconds. I was wondering if the Dictionary approach would be faster or not. Anyway, here is the code I came up with...

Code:

[table="width: 500"] [tr] [td]Sub UniqueListAndCountToo() Dim X As Long, LastRow As Long, Addr As String, Data As Variant, CountMatch As Variant LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row For X = 2 To 15 If Not Intersect(Selection.EntireColumn, Cells(1, X)) Is Nothing Then Addr = Addr & "&""|""&" & Cells(1, X).Resize(LastRow).Address(0, 0) Next Addr = Mid(Addr, 6) With Sheets("Sheet2") .UsedRange.Clear Data = Evaluate(Addr) .Range("A1").Resize(Cells(Rows.Count, "A").End(xlUp).Row) = Data .Columns("A").RemoveDuplicates Columns:=1, Header:=xlNo .Range("A1", .Cells(Rows.Count, "A").End(xlUp)).TextToColumns Range("C1"), xlDelimited, , , 0, 0, 0, 0, True, "|" .Range("B1").Value = "Count Match" Data = WorksheetFunction.Transpose(Data) LastRow = .Cells(Rows.Count, "A").End(xlUp).Row ReDim CountMatch(1 To LastRow - 1, 1 To 1) For X = 2 To LastRow CountMatch(X - 1, 1) = 1 + UBound(Filter(Data, .Cells(X, "A").Value)) Next .Range("B2").Resize(UBound(CountMatch)) = CountMatch With .Columns("A").Resize(, .Cells(1, Columns.Count).End(xlToLeft).Column) .AutoFit .HorizontalAlignment = xlCenter End With End With End Sub[/td] [/tr] [/table]

I forgot to mention... the above code always processes the columns from left to right no matter what order you select the cells that designate those columns in.

Peter_SSs · Dec 6, 2015

Rick Rothstein said:
... could it have something to do with the number of rows of data being processed?

It could, but until advised otherwise, I'm assuming data size similar to that posted.

Rick Rothstein said:
I was wondering if the Dictionary approach would be faster or not.

I suspect the dictionary would be slower if very large data.

Rick Rothstein said:
Anyway, here is the code I came up with...

Two remarks:

1. I would be very cautious about using Remove Duplicates. Unless M/Soft have fixed it in the latest version(s), it is unreliable & can fail without producing an error message. A repeatable example (for me anyway)

2. You would need to adjust all your counts up 1, remembering that Filter() produced a zero-based array.

Kishan · Dec 6, 2015

Rick Rothstein said:

Anyway, here is the code I came up with...

Code:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub UniqueListAndCountToo()
  Dim X As Long, LastRow As Long, Addr As String, Data As Variant, CountMatch As Variant
  LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
  For X = 2 To 15
    If Not Intersect(Selection.EntireColumn, Cells(1, X)) Is Nothing Then Addr = Addr & "&""|""&" & Cells(1, X).Resize(LastRow).Address(0, 0)
  Next
  Addr = Mid(Addr, 6)
  With Sheets("Sheet2")
    .UsedRange.Clear
    Data = Evaluate(Addr)
    .Range("A1").Resize(Cells(Rows.Count, "A").End(xlUp).Row) = Data
    .Columns("A").RemoveDuplicates Columns:=1, Header:=xlNo
    .Range("A1", .Cells(Rows.Count, "A").End(xlUp)).TextToColumns Range("C1"), xlDelimited, , , 0, 0, 0, 0, True, "|"
    .Range("B1").Value = "Count Match"
    Data = WorksheetFunction.Transpose(Data)
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    ReDim CountMatch(1 To LastRow - 1, 1 To 1)
    For X = 2 To LastRow
      CountMatch(X - 1, 1) = 1 + UBound(Filter(Data, .Cells(X, "A").Value))
    Next
    .Range("B2").Resize(UBound(CountMatch)) = CountMatch
    With .Columns("A").Resize(, .Cells(1, Columns.Count).End(xlToLeft).Column)
      .AutoFit
      .HorizontalAlignment = xlCenter
    End With
  End With
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Hi Rick Rothstein,

I am trying code with my data #post1 selecting column C, G, K it produce error ‘438’ after debug highlight following line.

Code:

.Columns("A").RemoveDuplicates Columns:=1, Header:=xlNo

.
after re-establish if I go to sheet2 I get result as shown below

Book1

A

1

P2|P6|P10

2

P2|P6|P10

3

X|1|1

4

2|1|1

5

1|X|1

6

1|1|1

7

X|1|1

8

1|X|X

9

1|1|X

10

2|1|X

11

2|1|1

12

1|2|2

13

2|1|X

14

1|2|1

15

X|2|1

16

X|1|2

17

2|X|2

18

1|X|1

19

2|1|1

20

1|1|2

21

1|2|X

22

1|2|1

Sheet2

Please could you check it?

Thank you

Regards,
Kishan

Unique Combination of Values

Kishan

Well-known Member

Excel Facts

Peter_SSs

MrExcel MVP, Moderator

Peter_SSs

MrExcel MVP, Moderator

Peter_SSs

MrExcel MVP, Moderator

Kishan

Well-known Member

Peter_SSs

MrExcel MVP, Moderator

Rick Rothstein

MrExcel MVP

Rick Rothstein

MrExcel MVP

Peter_SSs

MrExcel MVP, Moderator

Kishan

Well-known Member

Similar threads

Forum statistics

Share this page

Unique Combination of Values

Well-known Member

Excel Facts

MrExcel MVP, Moderator

MrExcel MVP, Moderator

MrExcel MVP, Moderator

Well-known Member

MrExcel MVP, Moderator

MrExcel MVP

MrExcel MVP

MrExcel MVP, Moderator

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock