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
Bookmarks