Separate counts depending on start patterns

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,648
Office Version
  1. 2010
Platform
  1. Windows
Using Excel 2000</SPAN></SPAN>

Hi,</SPAN></SPAN>

Note: Fill colours not required, it is just to shown to explain the example clearer</SPAN></SPAN>

I want a Formula or batter will be the VBA solution to " Separate counts depending on start patterns ", data in column C:D, count result in columns L:Q & in the S:X</SPAN></SPAN>

Count examples of the row 6, starting C6 has 1|X, so count instance and put them in cell L6 = 2 (Not in the S6), then look count for reverse match pattern X|1=1 put them in cell M6 =1 (not in the T6) then E3= 1|2 put them in N6 (Not in the V6)</SPAN></SPAN>

So the count must be as per left to right order and match put in to L:Q & S:X as per order too. </SPAN></SPAN>

Result data example</SPAN></SPAN>


Book1
ABCDEFGHIJKLMNOPQRSTUVWXYZ
1
2
3
4
5P1P2P3P4P5P6P71|XX|11|22|1X|22|XX|11|X2|11|22|XX|2
61|XX|11|21|12|21|X1|1211
7X|1X|1X|11|X1|11|XX|142
81|X1|22|1X|11|X1|22|12122
92|X1|11|2X|XX|11|12|11111
101|X2|22|1X|X2|2X|X1|111
111|X1|1X|X2|2X|X1|1X|X1
12X|XX|11|11|X1|X2|12|X1121
131|XX|12|12|11|12|X2|X1122
14X|2X|11|X1|11|1X|11|X122
151|11|11|1X|XX|11|12|X11
161|21|2X|11|2X|21|11|X3111
171|XX|11|2X|X1|X1|1X|1221
181|11|X1|11|1X|11|11|111
19X|12|X1|11|2X|11|2X|X221
201|11|X1|XX|1X|11|11|122
211|11|11|XX|21|11|11|2111
221|11|11|11|11|12|XX|111
231|22|11|11|11|11|X1|1111
241|1X|11|11|11|11|12|111
25X|XX|11|1X|11|2X|11|131
26X|21|12|11|11|1X|X1|X111
271|X2|21|11|2X|X1|11|X21
282|1X|X1|1X|X1|X1|11|111
29X|12|12|XX|11|2X|11|23121
30X|1X|X1|11|11|11|X1|111
31
32
Sheet7


Thank you in advance</SPAN></SPAN>

Regards,</SPAN></SPAN>
Kishan</SPAN></SPAN>
 
Last edited:
Maybe...Hope this helps M.
HI Marcelo Branco, that is the exactly what I wanted. Really thank you so much for taking a time to build a huge formula,

Unfortunately it does not work for me, I suspect "IFERROR" function is not available in my version 2000, Formula in L6 gives an error #¿NAME?
</SPAN></SPAN>

Have a nice day
</SPAN></SPAN>

Thank you
</SPAN></SPAN>

Regards,
</SPAN></SPAN>
Kishan
</SPAN></SPAN>
 
Last edited:
Upvote 0

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
If I really understand your requirements correctly, then the following macro should work for you. The code assumes the headers on Row 5 already exist on the sheet... the macro will fill the data underneath them.
Code:
[table="width: 500"]
[tr]
	[td]Sub PatternCounts()
  Dim R As Long, G As Long, X As Long, RowTxt As String, Col As Range
  Dim Data As Variant, Groups As Variant, CountMe As Variant
  Data = Range("C6", Cells(Rows.Count, "I").End(xlUp))
  ReDim Groups(1 To UBound(Data), 1 To 13)
  CountMe = Range("L5:Q5")
  For R = 1 To UBound(Data)
    RowTxt = ""
    For X = 1 To 6
      RowTxt = RowTxt & " " & Data(R, X)
    Next
    RowTxt = Trim(RowTxt)
    For X = 0 To 5 Step 2
      If InStr(RowTxt, CountMe(1, X + 1)) = 0 Then
        If InStr(RowTxt, CountMe(1, X + 2)) Then
          Groups(R, 8 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 2), ""))) / 3
        End If
      ElseIf InStr(RowTxt, CountMe(1, X + 2)) = 0 Then
        Groups(R, 1 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 1), ""))) / 3
      Else
        G = Sgn(InStr(RowTxt, CountMe(1, X + 1)) - InStr(RowTxt, CountMe(1, X + 2)))
        If G Then
          G = (G + 1) / 2
          If G Then
            Groups(R, 8 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 2), ""))) / 3
            Groups(R, 9 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 1), ""))) / 3
          Else
            Groups(R, 1 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 1), ""))) / 3
            Groups(R, 2 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 2), ""))) / 3
          End If
        End If
      End If
    Next
  Next
  Intersect(Rows("6:" & Rows.Count), Columns("L:X")).ClearContents
  With Range("L6").Resize(UBound(Groups), 13)
    .Value = Groups
    For Each Col In .Columns
      Col.Font.Color = Cells(5, Col.Column).Interior.Color
    Next
  End With
End Sub[/td]
[/tr]
[/table]
 
Upvote 0
If I really understand your requirements correctly, then the following macro should work for you. The code assumes the headers on Row 5 already exist on the sheet... the macro will fill the data underneath them.
Hi Rick Rothstein, thank you very much yes it is almost correct. </SPAN></SPAN>

Please could you check it is giving count (1) less?
For example S7=4, but code result is =3, O8=2, but code result is =1, U9=1, but code result is =0, W12=1, but code result is =0, W13=2, but code result is =1. Or is it giving me?
</SPAN></SPAN>


Regards,
</SPAN></SPAN>
Kishan
</SPAN></SPAN>
 
Upvote 0
Hi Rick Rothstein, thank you very much yes it is almost correct.

Please could you check it is giving count (1) less?
For example S7=4, but code result is =3, O8=2, but code result is =1, U9=1, but code result is =0, W12=1, but code result is =0, W13=2, but code result is =1. Or is it giving me?
I accidentally used a 6 for one of my loop counters when it should have been a 7. Here is the corrected code...
Code:
[table="width: 500"]
[tr]
	[td]Sub PatternCounts()
  Dim R As Long, G As Long, X As Long, RowTxt As String, Col As Range
  Dim Data As Variant, Groups As Variant, CountMe As Variant
  Data = Range("C6", Cells(Rows.Count, "I").End(xlUp))
  ReDim Groups(1 To UBound(Data), 1 To 13)
  CountMe = Range("L5:Q5")
  For R = 1 To UBound(Data)
    RowTxt = ""
    For X = 1 To 7
      RowTxt = RowTxt & " " & Data(R, X)
    Next
    RowTxt = Trim(RowTxt)
    For X = 0 To 5 Step 2
      If InStr(RowTxt, CountMe(1, X + 1)) = 0 Then
        If InStr(RowTxt, CountMe(1, X + 2)) Then
          Groups(R, 8 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 2), ""))) / 3
        End If
      ElseIf InStr(RowTxt, CountMe(1, X + 2)) = 0 Then
        Groups(R, 1 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 1), ""))) / 3
      Else
        G = Sgn(InStr(RowTxt, CountMe(1, X + 1)) - InStr(RowTxt, CountMe(1, X + 2)))
        If G Then
          G = (G + 1) / 2
          If G Then
            Groups(R, 8 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 2), ""))) / 3
            Groups(R, 9 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 1), ""))) / 3
          Else
            Groups(R, 1 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 1), ""))) / 3
            Groups(R, 2 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 2), ""))) / 3
          End If
        End If
      End If
    Next
  Next
  Intersect(Rows("6:" & Rows.Count), Columns("L:X")).ClearContents
  With Range("L6").Resize(UBound(Groups), 13)
    .Value = Groups
    For Each Col In .Columns
      Col.Font.Color = Cells(5, Col.Column).Interior.Color
    Next
  End With
End Sub[/td]
[/tr]
[/table]
 
Upvote 0
I accidentally used a 6 for one of my loop counters when it should have been a 7. Here is the corrected code...
Code:
[TABLE="width: 500"]
<TBODY>[TR]
[TD]Sub PatternCounts()
  Dim R As Long, G As Long, X As Long, RowTxt As String, Col As Range
  Dim Data As Variant, Groups As Variant, CountMe As Variant
  Data = Range("C6", Cells(Rows.Count, "I").End(xlUp))
  ReDim Groups(1 To UBound(Data), 1 To 13)
  CountMe = Range("L5:Q5")
  For R = 1 To UBound(Data)
    RowTxt = ""
    For X = 1 To 7
      RowTxt = RowTxt & " " & Data(R, X)
    Next
    RowTxt = Trim(RowTxt)
    For X = 0 To 5 Step 2
      If InStr(RowTxt, CountMe(1, X + 1)) = 0 Then
        If InStr(RowTxt, CountMe(1, X + 2)) Then
          Groups(R, 8 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 2), ""))) / 3
        End If
      ElseIf InStr(RowTxt, CountMe(1, X + 2)) = 0 Then
        Groups(R, 1 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 1), ""))) / 3
      Else
        G = Sgn(InStr(RowTxt, CountMe(1, X + 1)) - InStr(RowTxt, CountMe(1, X + 2)))
        If G Then
          G = (G + 1) / 2
          If G Then
            Groups(R, 8 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 2), ""))) / 3
            Groups(R, 9 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 1), ""))) / 3
          Else
            Groups(R, 1 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 1), ""))) / 3
            Groups(R, 2 + X) = (Len(RowTxt) - Len(Replace(RowTxt, CountMe(1, X + 2), ""))) / 3
          End If
        End If
      End If
    Next
  Next
  Intersect(Rows("6:" & Rows.Count), Columns("L:X")).ClearContents
  With Range("L6").Resize(UBound(Groups), 13)
    .Value = Groups
    For Each Col In .Columns
      Col.Font.Color = Cells(5, Col.Column).Interior.Color
    Next
  End With
End Sub
[/TD]
[/TR]
</TBODY>[/TABLE]
Hi Rick Rothstein, This works like a charm! </SPAN></SPAN>

Thanks, Thanks a lot for your help and time you spent for working on it.
</SPAN></SPAN>

Have a blessed day
</SPAN></SPAN>

Kind Regards,
</SPAN></SPAN>
Kishan :)
</SPAN></SPAN>
 
Upvote 0

Forum statistics

Threads
1,223,909
Messages
6,175,310
Members
452,634
Latest member
cpostell

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