count duplicated string in Range for each letter,Non Adjacent Row

Hi !!

please need some advice on this formula, i'm receiving 1 as result

What i'm trying to achieve is to Count the occurrences of each number In range EW3:FA38 with each Alphabet
In Range FK3:FK38
Example :
#24 = 2 occurrences with letter A
#29 = 2 occurrences with letter A:

I'm using this formula

=COUNT(IF((FK3:FK38="A")*(AA3:AA38="3"),EW3:FA38))

and i'm getting result 1, i Tried a sum,sumproducts with countif, and still..

=SUMPRODUCT(COUNTIF(EW$3:FA$9,INDEX(FK$3:FK$9,MATCH(AA9,FK$3:FK$9,0),0)))

 =SUM(COUNTIFS($EW$3:$FA$38,AA3,$FK$3:$FK$38,"A"))

Thank you !

Hi David,

one way could be

Formula:

=SUMPRODUCT(($FK$3:$FK$38="A")*($EW$3:$FA$38=29))

In AB3 and below:

Formula:

=SUMPRODUCT(($FK$3:$FK$38="A")*($EW$3:$FA$38=AA3))

Greetings

Try this formula in AB3 and drag it down:

Formula:

=SUMPRODUCT(($EW$3:$FA$38=AA3)*($FK$3:$FK$38=RIGHT($AB$2,1)))

Hi David,

A small contribution:

Sub Poquito(): Dim r As Long, c As Long, Key As String, k
With CreateObject("Scripting.Dictionary")
For r = 3 To 38: For c = 153 To 157
Key = Cells(r, c) & "_" & Cells(r, 167)
If .Exists(Key) Then
.Item(Key) = .Item(Key) + 1
Else
.Item(Key) = 1: End If
Next c: Next r
k = .Keys()
BubbleK:
        For r = LBound(k) To UBound(k) - 1
        If Val(Mid(k(r), 1, InStr(1, k(r), "_") - 1)) > _
        Val(Mid(k(r + 1), 1, InStr(1, k(r + 1), "_") - 1)) Then
    Key = k(r): k(r) = k(r + 1): k(r + 1) = Key
         GoTo BubbleK: End If: Next r
         
Cells(3, 169).Resize(UBound(k) + 1, 1).Value = WorksheetFunction.Transpose(k)
For r = 3 To UBound(k) + 4: Key = Cells(r, 169): Cells(r, 170) = .Item(Key): Next r
End With: End Sub

Hi Mr Xladept,

Thank you for your big contribution...
You're right about to apply code on this, because of the delete accident.. lol
code is excellent and i'm going to use it, But let me ask you :

I was trying to figure it how to modify the code and write the total occurrences on each letter column?
For example, to write the total occurrences on a column called "A" , Then i think i can figure for next Letter "C", "E"....."W"
Please see attached Pic.

PatternoccurrencesSample.png





Thank you so much !!


David

Hi David,

Thanks for the rep!

See if this works for you (I couldn't upload your image): Pequeno.xlsb

Sub Pequeno(): Dim r As Long, c As Long, Key As String, k, er As Long, S As String
With CreateObject("Scripting.Dictionary")
For r = 3 To 38: For c = 153 To 157
Key = Cells(r, c) & "_" & Cells(r, 167)
If .Exists(Key) Then
.Item(Key) = .Item(Key) + 1
Else
.Item(Key) = 1: End If
Next c: Next r
k = .Keys(): er = UBound(k) + 1
BubbleK:
        For r = LBound(k) To UBound(k) - 1
        If Val(Mid(k(r), 1, InStr(1, k(r), "_") - 1)) > _
        Val(Mid(k(r + 1), 1, InStr(1, k(r + 1), "_") - 1)) Then
    Key = k(r): k(r) = k(r + 1): k(r + 1) = Key
         GoTo BubbleK: End If: Next r
         
Cells(3, 169).Resize(UBound(k) + 1, 1).Value = WorksheetFunction.Transpose(k)
For r = 3 To er + 2: Key = Cells(r, 169): Cells(r, 169).Resize(1, 2).Value = Split(Key, "_")
Cells(r, 171) = .Item(Key): Next r
Range(Cells(3, 169), Cells(er + 2, 171)).Sort Key1:=Cells(3, 170), Header:=xlNo
For r = 3 To er + 2
S = Cells(r, 170) & Cells(r, 169): Range(S) = Cells(r, 171)
Next r
End With: End Sub

Hi David,

Thanks for the rep - glad you like the code - if the end result is all you need we can code that more elegantly!

Hi David,

Here's a more elegant routine with a less elegant name:Pequeno.xlsb

Sub Pulgar(): Dim r As Long, c As Long, Key As String, k, S As String, A
    A = Array("A", "C", "E", "G", "I", "K", "M", "O", "Q", "S", "U", "W")
        With CreateObject("Scripting.Dictionary")
        For r = 3 To 38: For c = 153 To 157
            Key = Cells(r, 167) & Cells(r, c)
                If .Exists(Key) Then
                    .Item(Key) = .Item(Key) + 1
                Else
                    .Item(Key) = 1: End If
        Next c: Next r: k = .Keys()
                For r = 3 To UBound(k)
        S = Left(k(r), 1): For c = 0 To UBound(A)
                            If A(c) = S Then Exit For
                            Next c
        Range(k(r)).Offset(0, 30 + 7 * c) = .Item(k(r))
                Next r: End With: End Sub

* I think that this is what you requested?