Count distinct value pairs in multiple columns

K

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,648
Office Version
  1. 2010
Platform
  1. Windows
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
ABCDEFGHIJKLMNOPQRSTU
1JorTempP1P2P3P4P5P6P7P8P9P10P11P12P13P14EM 1
2JorTempP1P2P3P4P5P6P7P8P9P10P11P12P13P14EM 1
3JorTempP1P2P3P4P5P6P7P8P9P10P11P12P13P14EM 1
4JorTempP1P2P3P4P5P6P7P8P9P10P11P12P13P14EM 1MultipleCountsCountsCounts
5JorTemp1234567891011121314EM 1Columns1|1|1|1|1|1|1X|X|2|2|1|2|11|1|1|1|1|1|X
6170/7111111111112XX11|2|3|4|5|6|734110
7270/7111111111112XX11|2|3|4|5|6|8287
8370/71111111212111X11|2|3|4|5|6|92515
9470/711111111112X1XX1|2|3|4|5|6|10289
10570/711111111111X2111|2|3|4|5|6|111922
11670/71111111211X12111|2|3|4|5|6|122214
12770/711111111XX212X11|2|3|4|5|6|131215
13870/71111111X11121121|2|3|4|5|6|142613
14970/71111111X1XX222X1|2|3|4|5|7|8
151070/71111111X12111211|2|3|4|5|7|9
161170/711111111X111X121|2|3|4|5|7|10
171270/7111111112X121221|2|3|4|5|7|11
181370/711111111XXX21X21|2|3|4|5|7|12
191470/711111112111X2111|2|3|4|5|7|13
201570/71111111X111X1221|2|3|4|5|7|14
211670/7111111112X21X1X1|2|3|4|5|8|9
221770/711111111111XXXX1|2|3|4|5|8|10
231870/71111111X11XXX111|2|3|4|5|8|11
241970/711111111111XXXX1|2|3|4|5|8|12
252070/7111111111X111211|2|3|4|5|8|13
262170/711111111X1XXX211|2|3|4|5|8|14
272270/7111111111X111211|2|3|4|5|9|10
282370/71111111112111211|2|3|4|5|9|11
292470/711111111112X11X1|2|3|4|5|9|12
302570/7111111111X2122X1|2|3|4|5|9|13
312670/7111111111X1XX221|2|3|4|5|9|14
322770/71111111X11X12211|2|3|4|5|10|11
332870/7111111111X2X2211|2|3|4|5|10|12
342970/7111111111X2122X1|2|3|4|5|10|13
353070/7111111111X1XX221|2|3|4|5|10|14
363170/71111111X11XXX111|2|3|4|5|11|12
373270/711111111111XXXX1|2|3|4|5|11|13
383370/7111111111X111211|2|3|4|5|11|14
393470/7111111112X11X2X1|2|3|4|5|12|13
403570/71111111112111X11|2|3|4|5|12|14
413670/71111111211X22211|2|3|4|5|13|14
423770/71111111112111211|2|3|4|6|7|8
433870/711111111112X11X1|2|3|4|6|7|9
443970/711111111X111X121|2|3|4|6|7|10
454070/711111111X1X11221|2|3|4|6|7|11
46171/721111111112X1XX1|2|3|4|6|7|12
47271/721111111111X2111|2|3|4|6|7|13
48371/72111111112111X11|2|3|4|6|7|14
49471/721111111X21X1X11|2|3|4|6|8|9
50571/72111111X112X1XX1|2|3|4|6|8|10
51671/72111111X121X1X11|2|3|4|6|8|11
52771/7211111111X2X2211|2|3|4|6|8|12
53871/72111111X111X1211|2|3|4|6|8|13
54971/7221X21XXX1XX12X1|2|3|4|6|8|14
551071/72XX21X1121121211|2|3|4|6|9|10
561171/721X2X1212XX112X1|2|3|4|6|9|11
571271/72X2X11111121XXX1|2|3|4|6|9|12
581371/7211X11X11XX11111|2|3|4|6|9|13
591471/7211X111X11111111|2|3|4|6|9|14
601571/7221X111211XXX1X1|2|3|4|6|10|11
611671/72X122X11X1111111|2|3|4|6|10|12
621771/722111221122XX121|2|3|4|6|10|13
631871/72111211111X21111|2|3|4|6|10|14
641971/721X21X1121X221X1|2|3|4|6|11|12
652071/721X1X11XX111X111|2|3|4|6|11|13
662171/72XXX111111111111|2|3|4|6|11|14
672271/72XX22121X11X12X1|2|3|4|6|12|13
682371/7211211111X111111|2|3|4|6|12|14
692471/72X111X1121121XX1|2|3|4|6|13|14
702571/721112X1X11X1XX11|2|3|4|7|8|9
712671/721X1112X1XXX21X1|2|3|4|7|8|10
722771/7211X1XXX111X12X1|2|3|4|7|8|11
732871/721X1X1X22X111121|2|3|4|7|8|12
742971/7211X22111X111121|2|3|4|7|8|13
753071/721XX1X11121111X1|2|3|4|7|8|14
763171/721XXXX1211111211|2|3|4|7|9|10
773271/722X1X111112X1221|2|3|4|7|9|11
783371/7211X122211X1XX21|2|3|4|7|9|12
793471/721111X111111XX11|2|3|4|7|9|13
803571/72111121X11X11111|2|3|4|7|9|14
813671/722X2X121X1X1XX11|2|3|4|7|10|11
823771/7221X111112X111X1|2|3|4|7|10|12
833871/721111X1X12111X21|2|3|4|7|10|13
84172/73X1212XX112X1121|2|3|4|7|10|14
85272/731X2221XX22XX111|2|3|4|7|11|12
86372/731X11XX22XX11XX1|2|3|4|7|11|13
87472/731X1221X11X12211|2|3|4|7|11|14
88572/73X1X1X11X111XX11|2|3|4|7|12|13
89672/73XXX1111X1X212X1|2|3|4|7|12|14
90772/732X1112XXX111211|2|3|4|7|13|14
Sheet1


Thank you in advance

Regards,
Kishan
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Sort by date Sort by votes
Try this:

Code: 
Sub kishan()
Dim i       As Long
Dim j       As Long
Dim Lr      As Long
Dim Pattern As String
Dim rng     As Range
Dim ar      As Variant
Dim arr     As Variant
Dim Sp      As Variant

Application.ScreenUpdating = False

Lr = Cells(Rows.Count, 1).End(xlUp).Row

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

For j = 1 To 3

Pattern = Cells(5, j + 18)

For Each cell In rng
    Sp = Split(cell, "|")
    arr = Application.Index(ar, Evaluate("row(1:" & UBound(ar) & ")"), Sp)
    ReDim Preserve arr(1 To UBound(arr, 1), 1 To UBound(arr, 2) + 1)
    
    For i = 1 To UBound(arr)
        arr(i, UBound(arr, 2)) = Join(Application.Index(arr, i, 0), "|")
        If arr(i, UBound(arr, 2)) = Pattern & "|" Then c = c + 1
    Next
    cell.Offset(, j) = c
    c = 0
Next
Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Faster one:

Code: 
Sub kishan()
Dim i       As Long
Dim c       As Long
Dim d       As Long
Dim e       As Long
Dim Lr      As Long
Dim Pattern As Variant
Dim rng     As Range
Dim ar      As Variant
Dim arr     As Variant
Dim Sp      As Variant

Application.ScreenUpdating = False

Lr = Cells(Rows.Count, 1).End(xlUp).Row

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

For Each cell In rng
        Sp = Split(cell, "|")
        arr = Application.Index(ar, Evaluate("row(1:" & UBound(ar) & ")"), Sp)
        ReDim Preserve arr(1 To UBound(arr, 1), 1 To UBound(arr, 2) + 1)
        
        For i = 1 To UBound(arr)
            arr(i, UBound(arr, 2)) = Join(Application.Index(arr, i, 0), "|")
            If arr(i, UBound(arr, 2)) = Pattern(1, 1) & "|" Then
                c = c + 1
            ElseIf arr(i, UBound(arr, 2)) = Pattern(1, 2) & "|" Then
                d = d + 1
            ElseIf arr(i, UBound(arr, 2)) = Pattern(1, 3) & "|" Then
                e = e + 1
            End If
        Next
        
    cell.Offset(, 1) = c: cell.Offset(, 2) = d: cell.Offset(, 3) = e
    c = 0: d = 0: e = 0
Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Here is my attempt at a solution for you...
Code: 
[table="width: 500"]
[tr]
	[td]Sub PatternCounts()
  Dim R As Long, C As Long, X As Long, Cnt As Long, Pattern 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)
      Pattern = Join(Application.Index(Data, X, 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]
I note that my code is slightly slower than the code Ombir posted (1.1 seconds versus 0.90 seconds for the posted data); however, that slowness is the result of a loop I built that allows you to have as many pattern/count columns (Column S, T, U, V, W, ...) as you want; that is, you are not restricted to only Columns S, T and U for your pattern counts.
 
Upvote 0
20% Faster than code that I posted in post 3 with flexibility of adding any number of patterns by changing range marked in red:

Code: 
Sub kishan()
Dim i       As Long
Dim c       As Long
Dim d       As Long
Dim e       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
Pattern = Application.Transpose(Application.Transpose(Range([COLOR=#ff0000]"S5:W5"[/COLOR])))

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 = Application.Index(ar, Evaluate("row(1:" & UBound(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
 
Upvote 0
Ombir said:
...with flexibility of adding any number of patterns by changing range marked in red:
Click to expand...
Instead of making the user edit the code each time they want to compare more or less patterns, why don't you have your code automatically determine the range for them?
 
Upvote 0
Rick Rothstein said:
Instead of making the user edit the code each time they want to compare more or less patterns, why don't you have your code automatically determine the range for them?
Click to expand...


Updated :

Code: 
Sub kishan()
Dim i       As Long
Dim c       As Long
Dim d       As Long
Dim e       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 = Application.Index(ar, Evaluate("row(1:" & UBound(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
 
Upvote 0
Ombir said:
Updated :
Click to expand...
Well done! Your code is nice and speedy (a touch more than half the time my code takes) and it now is flexible in that it adjusts to the number of columns needed like my code does. One note, though, you did not provide a Dim statement for the Cell, n and k variables.
 
Last edited:
Upvote 0
Well done! Your code is nice and speedy (a touch more than half the time my code takes) and it now is flexible in that it adjusts to the number of columns needed like my code does.
Click to expand...

Thank you.

One note, though, you did not provide a Dim statement for the Cell, n and k variables.
Click to expand...

Often forget to declare the variables. Don't have habit of using Option explicit. But this time I only left 3. That's great. Means I'm doing well ;)
 
Last edited:
Upvote 0
Rick Rothstein said:
Here is my attempt at a solution for you...

I note that my code is slightly slower than the code Ombir posted (1.1 seconds versus 0.90 seconds for the posted data); however, that slowness is the result of a loop I built that allows you to have as many pattern/count columns (Column S, T, U, V, W, ...) as you want; that is, you are not restricted to only Columns S, T and U for your pattern counts.
Click to expand...
Hi Rick Rothstein, thank you for your kind help

Your code works perfect as long as data find in column R (1st 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), "|")), "|")

Please could you check?

Kind Regards,
Kishan
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
VBA Code Help
Replies
4
Views
348
Peter_SSs
Peter_SSs
J
  • Solved
Help with calculation between work days based on condition
Replies
7
Views
313
Fluff
Fluff
K
  • Question
Fill any five cell only
Replies
3
Views
230
Peter_SSs
Peter_SSs
N
  • Question
Summarize Data from table - deal with dublicates
Replies
1
Views
65
Alex Blakenburg
A
I
  • Question
Formula to count duplicate Values every x # of rows
Replies
8
Views
357
Fluff
Fluff

Forum statistics

Threads
1,216,503
Messages
6,131,020
Members
449,615
Latest member
Nic0la

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