Count upper values only if the line below has 0

motilulla · Jan 3, 2019

Hello,

I need a VBA solution, which can count upper value only if the line below has 0. Result in column S

Example counts of the row 7 values, only if the lower row 8 has 0...Row 8 has 5 0's over it in the row 7 has numbers 0, 1, 3 & 4 (0=2, 1=1, 3=3 & 4=1) result S7 = 2 | 1 | 1 | 1, and the count method will be applied the same for rest of the rows.

Here is an example....

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

1

2

3

4

5

n1

n2

n3

n4

n5

n6

n7

n8

n9

n10

n11

n12

n13

n14

Count 0 To Increment Values

6

7

4

1

0

6

0

4

0

1

3

5

0

2

1

2 | 1 | 1 | 1

8

5

0

2

1

7

1

0

2

0

6

0

3

2

3

9

6

0

3

2

8

2

0

3

1

7

1

4

3

1 | 1 | 1

10

7

1

0

9

3

1

4

2

8

2

0

4

1 | 1 | 1

11

8

2

1

0

4

2

0

5

3

9

3

1

5

1 | 1 | 1 | 1

12

9

3

2

1

5

3

0

6

0

10

4

0

1 | 1 | 1

13

10

4

3

0

2

6

4

1

7

1

0

1

14

11

5

4

1

3

7

5

2

8

0

1

2

1 | 2 | 1 | 1 | 1

15

0

5

2

0

8

6

3

9

1

0

2

0

2 | 2 | 2 | 1 | 1

16

1

0

6

0

1

9

7

0

2

1

0

1

0

1 | 1 | 1

17

2

0

7

1

2

10

8

1

0

2

1

2

1

4 | 1 | 1

18

3

1

8

0

3

0

9

2

0

1

3

0

2 | 1 | 1 | 2 | 1

19

0

2

9

1

0

1

0

4

0

1

1 | 2 | 1 | 1

20

1

3

10

0

1

2

1

0

1

0

2

3 | 2 | 1

21

0

4

11

0

1

0

2

3

2

0

2

0

1 | 1

22

1

5

0

1

2

1

3

4

0

1

3

1

1 | 1 | 1 | 1

23

2

0

3

2

4

0

5

1

2

4

2

1 | 1

24

3

1

0

1

4

3

5

1

0

2

3

5

3

1 | 1 | 2 | 2

25

4

2

1

2

5

0

1

0

4

0

4

0

1

26

5

3

2

3

6

1

2

1

5

0

5

1

1 | 1 | 1 | 1

27

6

0

3

4

0

2

0

3

2

6

1

0

2

1 | 1 | 1 | 1 | 1

28

7

1

0

3

1

4

0

7

0

1

3

1 | 1 | 2

29

8

2

0

1

0

4

2

5

1

8

1

0

1 | 2 | 1 | 1 | 1

30

0

3

0

2

0

1

0

6

0

9

2

1

1 | 1 | 1 | 1

31

1

0

1

3

1

0

1

0

7

1

10

0

2

1 | 1

32

2

1

2

4

0

1

2

1

8

2

11

0

3

Sheet2

Thank you all

Excel 2000
Regards,
Moti

MickG · Jan 3, 2019

Try this:-

Code:

[COLOR="Navy"]Sub[/COLOR] MG03Jan13
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("D7", Range("D" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
   [COLOR="Navy"]If[/COLOR] Not Dn.Address = Rng(Rng.Count).Address [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare

    [COLOR="Navy"]For[/COLOR] Ac = 0 To 13
      [COLOR="Navy"]If[/COLOR] Dn.Offset(1, Ac).Value = 0 [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Offset(, Ac).Value) [COLOR="Navy"]Then[/COLOR]
                .Add Dn.Offset(, Ac).Value, 1
            [COLOR="Navy"]Else[/COLOR]
                .Item(Dn.Offset(, Ac).Value) = .Item(Dn.Offset(, Ac).Value) + 1
            [COLOR="Navy"]End[/COLOR] If
      [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac

 ReDim ray(1 To 14, 1 To 2)
 [COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
 c = 0
 [COLOR="Navy"]For[/COLOR] n = 0 To 10
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    [COLOR="Navy"]If[/COLOR] K = n [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        ray(c, 1) = K
        ray(c, 2) = .Item(K)
    [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]Next[/COLOR] K
 [COLOR="Navy"]Next[/COLOR] n
 
[COLOR="Navy"]Dim[/COLOR] nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
 nStr = ""
 [COLOR="Navy"]For[/COLOR] n = 1 To UBound(ray, 1)
    [COLOR="Navy"]If[/COLOR] Not IsEmpty(ray(n, 1)) [COLOR="Navy"]Then[/COLOR]
        nStr = nStr & IIf(nStr = "", ray(n, 2), "|" & ray(n, 2))
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
    Dn.Offset(, 15) = nStr
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn


[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

motilulla · Jan 3, 2019

MickG said:

Try this:-

Code:

[COLOR=navy]Sub[/COLOR] MG03Jan13
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range("D7", Range("D" & Rows.Count).End(xlUp))
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
   [COLOR=navy]If[/COLOR] Not Dn.Address = Rng(Rng.Count).Address [COLOR=navy]Then[/COLOR]
    [COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare

    [COLOR=navy]For[/COLOR] Ac = 0 To 13
      [COLOR=navy]If[/COLOR] Dn.Offset(1, Ac).Value = 0 [COLOR=navy]Then[/COLOR]
            [COLOR=navy]If[/COLOR] Not .Exists(Dn.Offset(, Ac).Value) [COLOR=navy]Then[/COLOR]
                .Add Dn.Offset(, Ac).Value, 1
            [COLOR=navy]Else[/COLOR]
                .Item(Dn.Offset(, Ac).Value) = .Item(Dn.Offset(, Ac).Value) + 1
            [COLOR=navy]End[/COLOR] If
      [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] Ac

 ReDim ray(1 To 14, 1 To 2)
 [COLOR=navy]Dim[/COLOR] K [COLOR=navy]As[/COLOR] Variant, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
 c = 0
 [COLOR=navy]For[/COLOR] n = 0 To 10
 [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
    [COLOR=navy]If[/COLOR] K = n [COLOR=navy]Then[/COLOR]
        c = c + 1
        ray(c, 1) = K
        ray(c, 2) = .Item(K)
    [COLOR=navy]End[/COLOR] If
   [COLOR=navy]Next[/COLOR] K
 [COLOR=navy]Next[/COLOR] n
 
[COLOR=navy]Dim[/COLOR] nStr [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
 nStr = ""
 [COLOR=navy]For[/COLOR] n = 1 To UBound(ray, 1)
    [COLOR=navy]If[/COLOR] Not IsEmpty(ray(n, 1)) [COLOR=navy]Then[/COLOR]
        nStr = nStr & IIf(nStr = "", ray(n, 2), "|" & ray(n, 2))
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] n
    Dn.Offset(, 15) = nStr
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dn


[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

MickG, the VBA is workings as treat. Thank you very much for the help!

Kind Regards,
Moti

MickG · Jan 4, 2019

You're welcome

Count upper values only if the line below has 0

motilulla

Well-known Member

Excel Facts

MickG

MrExcel MVP

motilulla

Well-known Member

MickG

MrExcel MVP

Similar threads

Forum statistics

Share this page

Count upper values only if the line below has 0

motilulla

Well-known Member

Excel Facts

MickG

MrExcel MVP

motilulla

Well-known Member

MickG

MrExcel MVP

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