Hello everyone I'am new to excel so any help is appreciated. If anyone need help in Safety and Health field I would be glad to help (Thats is my field of expertise).

If you have one column let's say ''A'' and in that column a couple of headings (a bolded word in a single cell, same column). In between these headings are cells with text. How to find number of cells in a range between two headings (keywords)? Let's say there are four headings. This means that there will be two separate ranges which will, when counted for number of cells, give two different numbers. The name of the Headings (keywords) is fixed but the address changes based on number of cells in between.

Example- Headings are: Apple, Orange, Pear, Lemon.

Day1:

A1 has heading Apple

A2 Some text

A3 Some text

A4 has heading Orange

A5 Some text

A6 Some text

A7 Some text

A8 has heading Pear

A9 Some text

A10 has heading Lemon

A6 Some text

A7 Some text

Result: B1 2 (Two apples)
B2 3 (Three Orange)
B3 1 (One Pear)
B4 2 (Lemon)

Day2:

A1 has heading Apple

A2 Some text

A3 has heading Orange

A4 Some text

A5 Some text

A6 has heading Pear

A7 Some text

A8 has heading Lemon

A9 Some text

Result: B1 1 (Two apples)
B2 2 (Three Orange)
B3 1 (One Pear)
B4 1 (Lemon)

Day3:

A1 has heading Apple

A2 Some text

A3 Some text

A4 has heading Pear

A5 Some text

A6 has heading Lemon

A7 Some text

Result: B1 2 (Two apples)
B2 0
B3 1 (One Pear)
B4 1 (Lemon)

So heading names are fixed and one day you can have some headings missing from the column.

I tryed some thing. It does work correct only for first Apple and Orange but if it should count between Apple and Pear it does not worl. So hope somebody can help me please

Here is the code:

Sub Ecount()

Worksheets("Sheet1").Select

    Dim myRange As Range
    
    Dim rngAP As Range
    Dim rngAP1 As Integer
    
    Dim rngOR As Range
    Dim rngOR1 As Integer
    
    Dim rngPE As Range
    Dim rngPE1 As Integer
    
    Dim rngLE As Range
    Dim rngLE1 As Integer

 
        Set rngAP = Worksheets("Sheet1").Range("E1:E100").Find("Apple", LookAt:=xlPart)
        Set rngOR = Worksheets("Sheet1").Range("E1:E100").Find("Orange", LookAt:=xlPart)
        Set rngPE = Worksheets("Sheet1").Range("E1:E100").Find("Pear", LookAt:=xlPart)
        Set rngLE = Worksheets("Sheet1").Range("E1:E100").Find("Lemon", LookAt:=xlPart)
        
    If IsNull(rngAP) = True Then
        rngAP1 = 0
        Else: rngAP1 = 1
        End If
        
    If IsNull(rngOR) = True Then
        rngOR1 = 0
        Else: rgnOR1 = 1
        End If
        
    If IsNull(rngPE) = True Then
        rngPE1 = 0
        Else: rngPE1 = 1
        End If
        
    If IsNull(rngLE) = True Then
        rngLE1 = 0
        Else: rngLE1 = 1
        End If
        
   
    If rngAP1 > 0 And rngAP1 > 0 Then
    Set myRange = Range(rngAP, rngOR)
  
    ElseIf rngAP1 > 0 And rngPE1 > 0 Then
    Set myRange = Range(rngAP, rngPE)
    
    Else
    Set myRange = Range(rngAP, rngLE)
    End If
    

myRange.Select

Dim NUM As Integer

NUM = myRange.Cells.SpecialCells(xlCellTypeConstants).count - 2


Worksheets("Sheet1").Select
 
Range("N3").Select

ActiveCell.Value = NUM
   
End Sub