Count distinct value pairs in multiple columns

Kishan · Aug 18, 2016

Using Excel 2000

Hi,
Pairs S5 ToRight
Multiple columns combinations R6 ToDown

Data Columns C:P (P1 To P14)
Cell R6 = 1|2|3|4|5|6|7 mean (P1+P2+P3+P4+P5+P6+P7) count Pairs S5 (1|1|1|1|1|1|1) result S6 = 34
Cell R7 = 1|2|3|4|5|6|8 mean (P1+P2+P3+P4+P5+P6+P8) count Pairs S5 (1|1|1|1|1|1|1) result S7 = 28

Example: I have count using AutoFilter as there are 14 columns so COMBIN(14,7) = 3432 I believe need VBA

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

1

Jor

Temp

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

EM 1

2

Jor

Temp

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

EM 1

3

Jor

Temp

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

EM 1

4

Jor

Temp

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

EM 1

Multiple

Counts

5

Jor

Temp

1

2

3

4

5

6

7

8

9

10

11

12

13

14

EM 1

Columns

1|1|1|1|1|1|1

X|X|2|2|1|2|1

1|1|1|1|1|1|X

6

1

70/71

1

2

X

1

1|2|3|4|5|6|7

34

1

10

7

2

70/71

1

2

X

1

1|2|3|4|5|6|8

28

7

8

3

70/71

1

2

1

2

1

X

1

1|2|3|4|5|6|9

25

15

9

4

70/71

1

2

X

1

X

1|2|3|4|5|6|10

28

9

10

5

70/71

1

X

2

1

1|2|3|4|5|6|11

19

22

11

6

70/71

1

2

1

X

1

2

1

1|2|3|4|5|6|12

22

14

12

7

70/71

1

X

2

1

2

X

1

1|2|3|4|5|6|13

12

15

13

8

70/71

1

X

1

2

1

2

1|2|3|4|5|6|14

26

13

14

9

70/71

1

X

1

X

2

X

1|2|3|4|5|7|8

15

10

70/71

1

X

1

2

1

2

1

1|2|3|4|5|7|9

16

11

70/71

1

X

1

X

1

2

1|2|3|4|5|7|10

17

12

70/71

1

2

X

1

2

1

2

1|2|3|4|5|7|11

18

13

70/71

1

X

2

1

X

2

1|2|3|4|5|7|12

19

14

70/71

1

2

1

X

2

1

1|2|3|4|5|7|13

20

15

70/71

1

X

1

X

1

2

1|2|3|4|5|7|14

21

16

70/71

1

2

X

2

1

X

1

X

1|2|3|4|5|8|9

22

17

70/71

1

X

1|2|3|4|5|8|10

23

18

70/71

1

X

1

X

1

1|2|3|4|5|8|11

24

19

70/71

1

X

1|2|3|4|5|8|12

25

20

70/71

1

X

1

2

1

1|2|3|4|5|8|13

26

21

70/71

1

X

1

X

2

1

1|2|3|4|5|8|14

27

22

70/71

1

X

1

2

1

1|2|3|4|5|9|10

28

23

70/71

1

2

1

2

1

1|2|3|4|5|9|11

29

24

70/71

1

2

X

1

X

1|2|3|4|5|9|12

30

25

70/71

1

X

2

1

2

X

1|2|3|4|5|9|13

31

26

70/71

1

X

1

X

2

1|2|3|4|5|9|14

32

27

70/71

1

X

1

X

1

2

1

1|2|3|4|5|10|11

33

28

70/71

1

X

2

X

2

1

1|2|3|4|5|10|12

34

29

70/71

1

X

2

1

2

X

1|2|3|4|5|10|13

35

30

70/71

1

X

1

X

2

1|2|3|4|5|10|14

36

31

70/71

1

X

1

X

1

1|2|3|4|5|11|12

37

32

70/71

1

X

1|2|3|4|5|11|13

38

33

70/71

1

X

1

2

1

1|2|3|4|5|11|14

39

34

70/71

1

2

X

1

X

2

X

1|2|3|4|5|12|13

40

35

70/71

1

2

1

X

1

1|2|3|4|5|12|14

41

36

70/71

1

2

1

X

2

1

1|2|3|4|5|13|14

42

37

70/71

1

2

1

2

1

1|2|3|4|6|7|8

43

38

70/71

1

2

X

1

X

1|2|3|4|6|7|9

44

39

70/71

1

X

1

X

1

2

1|2|3|4|6|7|10

45

40

70/71

1

X

1

X

1

2

1|2|3|4|6|7|11

46

1

71/72

1

2

X

1

X

1|2|3|4|6|7|12

47

2

71/72

1

X

2

1

1|2|3|4|6|7|13

48

3

71/72

1

2

1

X

1

1|2|3|4|6|7|14

49

4

71/72

1

X

2

1

X

1

X

1

1|2|3|4|6|8|9

50

5

71/72

1

X

1

2

X

1

X

1|2|3|4|6|8|10

51

6

71/72

1

X

1

2

1

X

1

X

1

1|2|3|4|6|8|11

52

7

71/72

1

X

2

X

2

1

1|2|3|4|6|8|12

53

8

71/72

1

X

1

X

1

2

1

1|2|3|4|6|8|13

54

9

71/72

2

1

X

2

1

X

1

X

1

2

X

1|2|3|4|6|8|14

55

10

71/72

X

2

1

X

1

2

1

2

1

2

1

1|2|3|4|6|9|10

56

11

71/72

1

X

2

X

1

2

1

2

X

1

2

X

1|2|3|4|6|9|11

57

12

71/72

X

2

X

1

2

1

X

1|2|3|4|6|9|12

58

13

71/72

1

X

1

X

1

X

1

1|2|3|4|6|9|13

59

14

71/72

1

X

1

X

1

1|2|3|4|6|9|14

60

15

71/72

2

1

X

1

2

1

X

1

X

1|2|3|4|6|10|11

61

16

71/72

X

1

2

X

1

X

1

1|2|3|4|6|10|12

62

17

71/72

2

1

2

1

2

X

1

2

1|2|3|4|6|10|13

63

18

71/72

1

2

1

X

2

1

1|2|3|4|6|10|14

64

19

71/72

1

X

2

1

X

1

2

1

X

2

1

X

1|2|3|4|6|11|12

65

20

71/72

1

X

1

X

1

X

1

X

1

1|2|3|4|6|11|13

66

21

71/72

X

1

1|2|3|4|6|11|14

67

22

71/72

X

2

1

2

1

X

1

X

1

2

X

1|2|3|4|6|12|13

68

23

71/72

1

2

1

X

1

1|2|3|4|6|12|14

69

24

71/72

X

1

X

1

2

1

2

1

X

1|2|3|4|6|13|14

70

25

71/72

1

2

X

1

X

1

X

1

X

1

1|2|3|4|7|8|9

71

26

71/72

1

X

1

2

X

1

X

2

1

X

1|2|3|4|7|8|10

72

27

71/72

1

X

1

X

1

X

1

2

X

1|2|3|4|7|8|11

73

28

71/72

1

X

1

X

1

X

2

X

1

2

1|2|3|4|7|8|12

74

29

71/72

1

X

2

1

X

1

2

1|2|3|4|7|8|13

75

30

71/72

1

X

1

X

1

2

1

X

1|2|3|4|7|8|14

76

31

71/72

1

X

1

2

1

2

1

1|2|3|4|7|9|10

77

32

71/72

2

X

1

X

1

2

X

1

2

1|2|3|4|7|9|11

78

33

71/72

1

X

1

2

1

X

1

X

2

1|2|3|4|7|9|12

79

34

71/72

1

X

1

X

1

1|2|3|4|7|9|13

80

35

71/72

1

2

1

X

1

X

1

1|2|3|4|7|9|14

81

36

71/72

2

X

2

X

1

2

1

X

1

X

1

X

1

1|2|3|4|7|10|11

82

37

71/72

2

1

X

1

2

X

1

X

1|2|3|4|7|10|12

83

38

71/72

1

X

1

X

1

2

1

X

2

1|2|3|4|7|10|13

84

1

72/73

X

1

2

1

2

X

1

2

X

1

2

1|2|3|4|7|10|14

85

2

72/73

1

X

2

1

X

2

X

1

1|2|3|4|7|11|12

86

3

72/73

1

X

1

X

2

X

1

X

1|2|3|4|7|11|13

87

4

72/73

1

X

1

2

1

X

1

X

1

2

1

1|2|3|4|7|11|14

88

5

72/73

X

1

X

1

X

1

X

1

X

1

1|2|3|4|7|12|13

89

6

72/73

X

1

X

1

X

2

1

2

X

1|2|3|4|7|12|14

90

7

72/73

2

X

1

2

X

1

2

1

1|2|3|4|7|13|14

Sheet1

Thank you in advance

Regards,
Kishan

Kishan · Aug 18, 2016

Ombir said:
Updated :

Hi Ombir, thank you for your kind help

Your post#7 code does not works as long as data find in column R (1^st column pattern in cell (R6) 1|2|3|4|5|6|7 & the last in (cell R3437) 8|9|10|11|12|13|14 total sets = 3432 (it works as long as database) but it works perfect as long as data finds in row S3 To Right.

Only the code works if database is in the range C6:P395 = total 390 lines if 1 more line is added it stop at the following line.

Code:

arr = Application.Index(ar, Evaluate("row(1:" & UBound(ar) & ")"), Sp)

Please could you check?

Kind Regards,
Kishan

Rick Rothstein · Aug 18, 2016

Kishan said:
Hi Rick Rothstein, thank you for your kind help

Your code works perfect as long as data find in column R (1^st column pattern in cell (R6) 1|2|3|4|5|6|7 & the last in (cell R3437) 8|9|10|11|12|13|14 total sets = 3432, and also it works perfect as long as data finds in row S3 To Right.

Only the code works if database is in the range C6:P395 = total 390 lines if 1 more line is added it stop at the following line.

Code:

Pattern = Join(Application.Index(Data, X, Split(Results(R, 1), "|")), "|")

I am confused... are you saying your data is not actually where your example showed it to be?

Kishan · Aug 18, 2016

Rick Rothstein said:
I am confused... are you saying your data is not actually where your example showed it to be?

Hi Rick, we are here again with the same my version problem ( It is Not Your Code ) http://www.mrexcel.com/forum/excel-...n-ant-list-row-n%BA-interval.html#post4598483 indicated left corner at the top post#1

Thank you

Kind Regards,
Kishan

Kishan · Aug 18, 2016

Rick Rothstein said:
I am confused... are you saying your data is not actually where your example showed it to be?

Sorry Rick, in reply to your question correct answer is no I have not change my example data layout but when I try with my original database which has 8000+Rows it stop at line shown in the post#10 if I reduce it to 390 lines works perfect. I imagine it is because of version I am using excel 2000

Thank you

Kind Regards,
Kishan

Kishan · Aug 19, 2016

Application.Index has line limiting to use with version 2000 please require modification so the code could work with my database has 8000+ lines

Thank you

Regards,
Kishan

Ombir · Aug 19, 2016

Kishan,

You're from which country ????

Why you're using such an outdated version. 16 years matters a lot.

If you're interested than I can provide you then link to download the latest version.

Kishan · Aug 19, 2016

Ombir said:
Kishan,

Why you're using such an outdated version. 16 years matters a lot.

If you're interested than I can provide you then link to download the latest version.

Hi Ombir, I really appreciate that you are thinking about me and offering link to update the software. Which I cannot because then I need to change my older computer also, for the time being I have to wait because my situation does not allows me.

Thank You

Kind Regards,
Kishan

Ombir · Aug 19, 2016

Does this works ??

Code:

Dim x       As Long
Dim r       As Long
Dim temp    As Variant
Dim ele     As Variant
Dim dict    As Object
Sub kishan()
Dim i       As Long
Dim n       As Long
Dim k       As Long
Dim Lr      As Long
Dim rng     As Range
Dim nar     As Variant
Dim Pattern As Variant
Dim out     As Variant
Dim ar      As Variant
Dim arr     As Variant
Dim Sp      As Variant

Application.ScreenUpdating = False

Set dict = CreateObject("scripting.dictionary")

Lr = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("S5").Resize(, Cells(5, Columns.Count).End(xlToLeft).Column - 18)
Pattern = Application.Transpose(Application.Transpose(rng))

ReDim out(1 To Lr, 1 To UBound(Pattern))

ar = Range("C6:P" & Lr)
Set rng = Range("R6:R" & Lr)

For Each cell In rng
        n = n + 1
        Sp = Split(cell, "|")
        arr = Slicearray(ar, Sp)
        ReDim nar(1 To UBound(arr, 1))
        
        For i = 1 To UBound(arr)
            nar(i) = Join(Application.Index(arr, i, 0), "|")
            For k = 1 To UBound(Pattern)
                If Pattern(k) = nar(i) Then
                    out(n, k) = out(n, k) + 1
                    Exit For
                End If
            Next
        Next
Next
Range("S6").Resize(n, UBound(out, 2)) = out
Application.ScreenUpdating = True
End Sub

Function Slicearray(data As Variant, col As Variant) As Variant
With dict
For x = LBound(data, 1) To UBound(data, 1)
  r = 0
  ReDim temp(1 To UBound(col) + 1)
    For Each ele In col
        r = r + 1
        temp(r) = data(x, ele)
    Next
    dict.Item(.Count) = temp
Next
Slicearray = Application.Index(dict.items, 0, 0)
.RemoveAll
End With
End Function

Rick Rothstein · Aug 19, 2016

Kishan said:
Application.Index has line limiting to use with version 2000 please require modification so the code could work with my database has 8000+ lines

See if this modified version of the code I posted earlier works for you...

Code:

[table="width: 500"]
[tr]
	[td]Sub PatternCounts()
  Dim R As Long, C As Long, X As Long, Z As Long, Cnt As Long
  Dim Pattern As String, Lines(1 To 14) As String
  Dim Data As Variant, Results As Variant
  Data = Range("C6", Cells(Rows.Count, "P").End(xlUp))
  Results = Range("R5", Cells(Cells(Rows.Count, "R").End(xlUp).Row, Cells(5, Columns.Count).End(xlToLeft).Column))
  For R = 2 To UBound(Results, 1)
    For X = 1 To UBound(Data)
      For Z = 1 To 14
        Lines(Z) = Data(X, Z)
      Next
      Pattern = Join(Application.Index(Lines, 1, Split(Results(R, 1), "|")), "|")
      For C = 2 To UBound(Results, 2)
        If Pattern = Results(1, C) Then Results(R, C) = Results(R, C) + 1
      Next
    Next
  Next
  Range("R5").Resize(UBound(Results, 1), UBound(Results, 2)) = Results
End Sub[/td]
[/tr]
[/table]

Ombir · Aug 19, 2016

If above code doesn't work then this will definitely work as I've removed Application.Index which is causing the error in you excel version. Performance is still same :

Code:

Dim x       As Long
Dim c       As Long
Dim ele     As Variant
Dim temp    As Variant
Sub kishan()
Dim i       As Long
Dim n       As Long
Dim k       As Long
Dim Lr      As Long
Dim rng     As Range
Dim nar     As Variant
Dim Pattern As Variant
Dim out     As Variant
Dim ar      As Variant
Dim arr     As Variant
Dim Sp      As Variant

Application.ScreenUpdating = False

Lr = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("S5").Resize(, Cells(5, Columns.Count).End(xlToLeft).Column - 18)
Pattern = Application.Transpose(Application.Transpose(rng))

ReDim out(1 To Lr, 1 To UBound(Pattern))

ar = Range("C6:P" & Lr)
Set rng = Range("R6:R" & Lr)

For Each cell In rng
        n = n + 1
        Sp = Split(cell, "|")
        arr = Slicearray(ar, Sp)
        ReDim nar(1 To UBound(arr, 1))
        
        For i = 1 To UBound(arr)
            nar(i) = Join(Application.Index(arr, i, 0), "|")
            For k = 1 To UBound(Pattern)
                If Pattern(k) = nar(i) Then
                    out(n, k) = out(n, k) + 1
                    Exit For
                End If
            Next
        Next
Next
Range("S6").Resize(n, UBound(out, 2)) = out
Application.ScreenUpdating = True
End Sub

Function Slicearray(data As Variant, col As Variant) As Variant
ReDim temp(1 To UBound(data, 1), 1 To UBound(col) + 1)
For Each ele In col
  c = c + 1
    For x = LBound(data, 1) To UBound(data, 1)
        temp(x, c) = data(x, ele)
    Next
Next
Slicearray = temp
c = 0
End Function

Count distinct value pairs in multiple columns

Kishan

Well-known Member

Kishan

Well-known Member

Excel Facts

Rick Rothstein

MrExcel MVP

Kishan

Well-known Member

Kishan

Well-known Member

Kishan

Well-known Member

Ombir

Active Member

Kishan

Well-known Member

Ombir

Active Member

Rick Rothstein

MrExcel MVP

Ombir

Active Member

Similar threads

Forum statistics

Share this page

Count distinct value pairs in multiple columns

Well-known Member

Well-known Member

Excel Facts

MrExcel MVP

Well-known Member

Well-known Member

Well-known Member

Active Member

Well-known Member

Active Member

MrExcel MVP

Active 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