Separate database and count successive in string

Kishan · Aug 24, 2016

Using Excel 2000

Hi,

Database Columns C:P
Count successive ( 1’s ) in columns R:AE (count successive as in order appears ) Row3 1’s result 3-1-1-2-1
Count successive ( X’s + 2’s ) in columns AG:AT (count successive as in order appears ) Row3 X’s & 2’s result 1-3-2

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

Y

Z

AA

AB

AC

AD

AE

AF

AG

AH

AI

AJ

AK

AL

AM

AN

AO

AP

AQ

AR

AS

AT

1

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

2

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

3

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

4

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

5

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

1

X

2

X

2

X

2

X

2

X

2

X

2

X

2

6

X

1

2

1

2

1

2

X

1

X

1

3

1

2

1

3

2

7

X

2

1

X

1

2

1

X

2

1

2

1

2

1

2

1

8

X

1

2

1

2

1

2

X

1

X

1

2

1

2

1

3

2

9

2

1

X

2

1

X

1

2

1

2

3

0

1

2

10

1

X

1

X

1

2

1

X

1

2

1

3

11

X

2

X

2

X

1

2

1

2

4

1

2

1

2

12

X

1

2

1

2

1

X

1

X

1

3

2

1

2

13

1

X

2

1

X

1

2

1

X

1

3

2

1

2

1

14

1

2

X

1

X

1

X

3

1

0

1

8

15

1

X

1

X

1

2

X

1

2

5

1

3

1

16

X

1

X

2

1

2

X

1

X

1

3

2

5

17

1

X

1

2

1

X

1

2

1

X

1

2

1

3

1

18

1

X

1

2

X

1

5

3

2

1

2

1

19

X

1

X

1

2

1

X

2

4

2

3

1

2

20

1

2

1

X

1

2

X

1

X

2

4

1

0

1

2

1

2

1

21

1

2

1

X

1

2

1

X

1

3

2

1

2

1

0

2

1

22

2

1

X

1

X

1

2

1

2

1

2

3

0

1

2

23

1

2

1

2

1

X

1

5

2

1

0

2

3

24

X

1

2

1

2

1

X

1

X

2

1

2

25

1

X

1

4

9

1

26

X

1

2

1

X

1

X

1

4

2

1

3

Sheet1

Thank you in advance

Regards,
Kishan

B___P · Aug 25, 2016

Here the code with requested amendments:

Code:

Sub kishan2()
Dim range1 As Range
Dim range1b As Range
Dim range2 As Range
Dim range3 As Range
Dim lastrow As Long
Dim c As Range
Dim d As Range
Dim alfa As String
Dim alfa1 As String
Dim alfaX2 As String
Dim Pattern1
Dim PatternX2
Dim t As Long
Dim off As Long

lastrow = ActiveSheet.Cells(6, 3).End(xlDown).Row
Set range1 = Range(Cells(6, 3), Cells(6, 3).End(xlDown))
Set range2 = ActiveSheet.Range(Range("R6"), Cells(lastrow, 31))
Set range3 = ActiveSheet.Range(Range("AG6"), Cells(lastrow, 46))
range2.ClearContents
range3.ClearContents
For Each c In range1
    Set range1b = Range(c, Cells(c.Row, 17))
    
    For Each d In range1b
        alfa = alfa & d.Value
    Next d
    
    alfa1 = Trim(Replace(Replace(alfa, 2, " "), "X", " "))
    
    Do Until InStr(1, alfa1, "  ") = 0
        alfa1 = Replace(alfa1, "  ", " ")
    Loop
    
    alfaX2 = Trim(Replace(alfa, 1, " "))
    Do Until InStr(1, alfaX2, "  ") = 0
        alfaX2 = Replace(alfaX2, "  ", " ")
    Loop
    alfaX2 = Replace(Replace(alfaX2, "2X", "2 X"), "X2", "X 2")
    Pattern1 = Split(alfa1, " ")
    
    For t = 0 To UBound(Pattern1)
        Cells(c.Row, 18 + t).Value = Len(Pattern1(t))
    Next t
    
    PatternX2 = Split(alfaX2, " ")
    
    For t = 0 To UBound(PatternX2)
        If (t = 0 And Mid(PatternX2(t), 1, 1) = "2") Then 'Or (t = 0 And Mid(PatternX2(t), 1, 1) = "X") Then
            Cells(c.Row, 33 + t).Value = 0
            Cells(c.Row, 33 + t + 1).Value = Len(PatternX2(t))
            off = 1
        Else
            Cells(c.Row, 33 + t + off).Value = Len(PatternX2(t))
        End If
    Next t
    
    off = 0
    alfa = ""
    alfa1 = ""
    alfaX2 = ""
Next c
End Sub

Code gives results as in post #6 But I cannot guess why if X2 series begins with 2 in first output cell you want a 0 and with something like 21X1X it seems you want 0111 while I figured it was 01101. In other words a long series of single 2 or X take a place in report where you expected to count the other sign.

Hope it helps

Kishan · Aug 25, 2016

B___P said:
Here the code with requested amendments:

Code:

Sub kishan2() End Sub

Code gives results as in post #6 But I cannot guess why if X2 series begins with 2 in first output cell you want a 0 and with something like 21X1X it seems you want 0111 while I figured it was 01101. In other words a long series of single 2 or X take a place in report where you expected to count the other sign.

Hope it helps

In the given example below I removed Step-1 (which was count consecutive 1’s) to explain better only X2 series and output 0 first if the series start with 2

Book1
A B C D E F G H I J K L M N O P Q R S T U V W X Y Z AA AB AC AD AE AF AG AH AI AJ AK AL AM AN AO AP AQ AR AS AT
1 P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 P13 P14
2 P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 P13 P14
3 P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 P13 P14
4 P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 P13 P14
5 P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 P13 P14 X 2 X 2 X 2 X 2 X 2 X 2 X 2 X 2
6 2 1 X 1 X 1 1 1 1 1 1 1 1 1 0 1 2 0 1 1 1
7 X X X X X X 1 1 2 2 2 2 2 2 6 6 6 6
8 2 2 2 2 2 2 2 2 2 1 X X X X 0 9 4 0 9 4
9 1 X 2 X 1 X 2 2 2 1 X X X 1 1 1 2 3 3 1 1 1 1 3 3
10 1 1 1 2 X X X 1 X X 1 X X X 0 1 8 0 1 3 2 3
11 1 1 1 1 1 2 1 1 2 1 X X X 1 0 2 3 0 1 1 3
12 X 1 X 1 X 1 1 X 1 2 1 1 X 1 4 1 1 1 1 1 1 1 1
Step 2 & 3

Hi B___P, to workout steps 2 & 3 in conjunction correctly I have to decide in both steps 2 & 3 either series start with X2 or with 2X in my case I decided series for both steps 2 & 3 to be started with X2

For example Row6 series starts with 2
Result Step-1 is X=0, 2=1 & X=2………...……0-1-2
Result Step-2 Is X=0, 2=1 & X, X=1-1………0-1-1-1
So output 0 in X column if start with 2 which balanced both steps and I can read clearly (X =0) (2 =1) & X = 2 but as result is 1-1 this mean X’s are separate

For example Row9 series starts with X
Result Step-1 is X=1, 2=1, X=2, 2=3, X=3……..………1-1-2-3-3
Result Step-2 Is X=1, 2=1, X=1-1, 2=3, X=3….………1-1-1-1-3-3So output 1 in X column if start with X which balanced both steps and I can read clearly (X =1) (2 =1) (X = 1-1) (2=3) & (X=3) so this says 2^nd time 2 X’s are appeared separate

For example Row12 series starts with X
Result Step-1 is X=4, 2=1, X=1……........………4-1-1
Result Step-2 Is X=1-1-1-1, 2=1, X=1….………1-1-1-1-1-1So output 1 in X column if start with X which balanced both steps and I can read clearly (X =4) (2 =1) (X = 1) so this says 1^st time 4 X’s are appeared separate

Hope I have explained well if not please let me know I will try again my best

Thank you for all your kind help and time

Regards,
Kishan

B___P · Aug 26, 2016

I split my answer in 3 parts one for each step.
1st step: counting 1s

Code:

Sub kishan_step1()
Dim range1 As Range
Dim range1b As Range
Dim range2 As Range
Dim lastrow As Long
Dim c As Range
Dim d As Range
Dim alfa As String
Dim alfa1 As String
Dim Pattern1
Dim t As Long
Dim off As Long

lastrow = ActiveSheet.Cells(6, 3).End(xlDown).Row
Set range1 = Range(Cells(6, 3), Cells(6, 3).End(xlDown))
Set range2 = ActiveSheet.Range(Range("R6"), Cells(lastrow, 31))
range2.ClearContents
For Each c In range1
    Set range1b = Range(c, Cells(c.Row, 17))
    
    For Each d In range1b
        alfa = alfa & d.Value
    Next d
    
    alfa1 = Trim(Replace(Replace(alfa, 2, " "), "X", " "))
    
    Do Until InStr(1, alfa1, "  ") = 0
        alfa1 = Replace(alfa1, "  ", " ")
    Loop
    
    Pattern1 = Split(alfa1, " ")
    
    For t = 0 To UBound(Pattern1)
        Cells(c.Row, 18 + t).Value = Len(Pattern1(t))
    Next t
    
    alfa = ""
    alfa1 = ""
Next c
End Sub

This puts results starting from cell R6. Results are the same as my 1sp post.

B___P · Aug 26, 2016

step2, counting Xs and 2s

Code:

Sub kishan_step2()
Dim range1 As Range
Dim range1b As Range
Dim range3 As Range
Dim lastrow As Long
Dim c As Range
Dim d As Range
Dim alfa As String
Dim alfaX2 As String
Dim PatternX2
Dim t As Long
Dim off As Long

lastrow = ActiveSheet.Cells(6, 3).End(xlDown).Row
Set range1 = Range(Cells(6, 3), Cells(6, 3).End(xlDown))
Set range3 = ActiveSheet.Range(Range("AG6"), Cells(lastrow, 46))

range3.ClearContents
For Each c In range1
    Set range1b = Range(c, Cells(c.Row, 17))
    
    For Each d In range1b
        alfa = alfa & d.Value
    Next d
    
    alfaX2 = Trim(Replace(alfa, 1, " "))
    Do Until InStr(1, alfaX2, "  ") = 0
        alfaX2 = Replace(alfaX2, "  ", " ")
    Loop
    alfaX2 = Replace(Replace(alfaX2, "2X", "2 X"), "X2", "X 2")
    
    PatternX2 = Split(alfaX2, " ")
    
    For t = 0 To UBound(PatternX2)
        If (t = 0 And Mid(PatternX2(t), 1, 1) = "2") Then
            Cells(c.Row, 33 + t).Value = 0
            Cells(c.Row, 33 + t + 1).Value = Len(PatternX2(t))
            off = 1
        Else
            Cells(c.Row, 33 + t + off).Value = Len(PatternX2(t))
        End If
    Next t
    
    off = 0
    alfa = ""
    alfaX2 = ""
Next c
End Sub

This is a kind of helper step as you stated in your first post but after all it reveals to be useful for some evaluations. Finally I got what you meant. I keep treating it as an helper step so results start at cell AG6

B___P · Aug 26, 2016

And here the 3rd step

Code:

Sub kishan_step3()
Dim range1 As Range
Dim range1b As Range
Dim range4 As Range
Dim lastrow As Long
Dim c As Range
Dim d As Range
Dim alfa As String
Dim alfaX2 As String
Dim PatternX2
Dim t As Long
Dim off As Long

lastrow = ActiveSheet.Cells(6, 3).End(xlDown).Row
Set range1 = Range(Cells(6, 3), Cells(6, 3).End(xlDown))
Set range4 = ActiveSheet.Range(Range("Av6"), Cells(lastrow, 61))
range4.ClearContents
For Each c In range1
    Set range1b = Range(c, Cells(c.Row, 17))
    
    For Each d In range1b
        alfa = alfa & d.Value
    Next d
    
    alfaX2 = Trim(Replace(alfa, 1, ""))
    alfaX2 = Replace(Replace(alfaX2, "2X", "2 X"), "X2", "X 2")
    PatternX2 = Split(alfaX2, " ")
    
    For t = 0 To UBound(PatternX2)
        If (t = 0 And Mid(PatternX2(t), 1, 1) = "2") Then
            Cells(c.Row, 48 + t).Value = 0
            Cells(c.Row, 48 + t + 1).Value = Len(PatternX2(t))
            off = 1
        Else
            Cells(c.Row, 48 + t + off).Value = Len(PatternX2(t))
        End If
    Next t
    
    off = 0
    alfa = ""
    alfaX2 = ""
Next c
End Sub

It aggregates Xs and 2s not interrupted by the other sign. Results start at cell AV6 and are the same as my first post.

I hope the 3 steps comply with your needs and help you. I don't know from which country you are writing so I wish you a nice rest of the day.

Kishan · Aug 26, 2016

B___P said:
I split my answer in 3 parts one for each step.
1st step: counting 1s

Code:

[COLOR=#000000]Sub kishan_[B]step1[/B]() End Sub [/COLOR]

This puts results starting from cell R6. Results are the same as my 1sp post.

B___P said:
step2, counting Xs and 2s

Code:

[COLOR=#000000]Sub kishan_[B]step2[/B]() End Sub[/COLOR]

This is a kind of helper step as you stated in your first post but after all it reveals to be useful for some evaluations. Finally I got what you meant. I keep treating it as an helper step so results start at cell AG6

B___P said:
And here the 3rd step

Code:

[COLOR=#000000]Sub kishan_[B]step3[/B]() End Sub [/COLOR]

It aggregates Xs and 2s not interrupted by the other sign. Results start at cell AV6 and are the same as my first post.

I hope the 3 steps comply with your needs and help you. I wish you a nice rest of the day.

Magnificent!! B___P, Everyone says, "Questions make the road to reach a target." But I believe it is more important to get a good answer for your Question.

Building 3 macros in to 3-separate steps that help me a lot

Thank you very much for giving best answers, understanding my viewpoint.

I really appreciate your time.

Have a good weekend

Kind Regards,
Kishan

Separate database and count successive in string

Kishan

Well-known Member

B___P

Active Member

Excel Facts

Kishan

Well-known Member

B___P

Active Member

B___P

Active Member

B___P

Active Member

Kishan

Well-known Member

Similar threads

Forum statistics

Share this page

Separate database and count successive in string

Kishan

Well-known Member

B___P

Active Member

Excel Facts

Kishan

Well-known Member

B___P

Active Member

B___P

Active Member

B___P

Active Member

Kishan

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