Count rows per Merge Value

[airforceone]

just thinking...
although some might say that merge cells is the mortal enemy of macro but just the same I would like to throw this not so important question or not
how or can we count rows of a certain column until merge value changes?
say with the given table
Bird row count would be 5
Habitat row count is 8
Mammal is 4 and
Invert is 7

00 GRAMS TEST FILE.xlsx
	A	B	C	D
1	name	gen_spec	element	subelement
2	Purple sandpiper	Calidris maritima	BIRD	shorebird
3	Long-billed marsh-wren	Cistothorous palustris		passerine
4	Short-billed marsh-wren	Cistothorous platensis		passerine
5	Baird's sandpiper	Calidris bairdii		shorebird
6	Northern goshawk	Accipiter gentilis		raptor
7	Beach pea	Lathyrus japonicus var. maritimus	HABITAT	plant
8	Beach sumac	Rhus aromatica var. arenaria		upland
9	Black-fruit mountain-ricegrass	Piptatherum racemosa		upland
10	Brown-fruited rush	Juncus pelocarpus		wetland
11	Capitate spikerush	Eleocharis geniculata		wetland
12	Seaside spurge	Chamaesyce polygonifolia		upland
13	Rock sandwort	Minvartia michauxii michauxii		upland
14	Broadleaf sedge	Carex platphylla		upland
15	Meadow vole	Microtus pennsylvanicus	MAMMAL	sm_mammal
16	Red fox	Vulpes vulpes		canine
17	Striped skunk	Mephitis mephitis		sm_mammal
18	Gray wolf	Canis lupus		canine
19	Belted kingfisher	Ceryle alcyon	INVERT	passerine
20	Mute swan	Cygnus olor		waterfowl
21	Bald eagle	Haliaeetus leucocephalus		raptor
22	Red-shouldered hawk	Buteo lineatus		raptor
23	Sharp-shinned hawk	Accipiter striatus		raptor
24	Merlin	Falco columbarius		raptor
25	Rough-legged hawk	Buteo lagopus		raptor
Sheet7

 

[kevin9999]

Something like...

Option Explicit
Sub RowsPerMerge()
    Dim lr As Long, i As Long, RowsPer As Long, NamePer As String
    lr = Cells(Rows.Count, 3).End(3).Row
    For i = 2 To lr
        RowsPer = Range("C" & i).MergeArea.Rows.Count
        NamePer = Range("C" & i).Value
        If RowsPer > 1 Then
            MsgBox NamePer & " has " & RowsPer & " rows"
            i = i + RowsPer - 1
        End If
    Next i
End Sub

 

[airforceone]

Something like...

Option Explicit
Sub RowsPerMerge()
    Dim lr As Long, i As Long, RowsPer As Long, NamePer As String
    lr = Cells(Rows.Count, 3).End(3).Row
    For i = 2 To lr
        RowsPer = Range("C" & i).MergeArea.Rows.Count
        NamePer = Range("C" & i).Value
        If RowsPer > 1 Then
            MsgBox NamePer & " has " & RowsPer & " rows"
            i = i + RowsPer - 1
        End If
    Next i
End Sub

thanks @kevin9999 just stumbled this code but will try to test yours also thanks anyway...

Sub RowsCount()

    Dim i As Integer, RowCount As Long, LastRow As Long
    Dim SourceSHT As Worksheet

    Set SourceSHT = ActiveSheet
    ActiveSheet.Select
    LastRow = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row
    
    For i = 3 To LastRow
        RowCount = Range("A" & i).MergeArea.Rows.Count
        If RowCount > 1 Then
            MsgBox ("Cell [A" & i & "] has " & RowCount & " merged rows")
            i = i + RowCount - 1
        End If
    Next i

End Sub

 

[bebo021999]

Option Explicit
Sub test()
Dim cell As Range
Worksheets("SourceSHT").Activate
For Each cell In Range("C2:C" & Cells(Rows.Count, "D").End(xlUp).Row)
    If cell.Value <> "" Then MsgBox cell.MergeArea(1).Value & " has " & cell.MergeArea.Count & " merged rows"
Next
End Sub

 

[kevin9999]

Option Explicit
Sub test()
Dim cell As Range
Worksheets("SourceSHT").Activate
For Each cell In Range("C2:C" & Cells(Rows.Count, "D").End(xlUp).Row)
    If cell.Value <> "" Then MsgBox cell.MergeArea(1).Value & " has " & cell.MergeArea.Count & " merged rows"
Next
End Sub

@bebo021999 I really like this - the less code the better

 

[airforceone]

follow-up if anyone cares, how can I count number of merge entry example with the given table above is 4 (Bird, Habitat, Mammal, Invert). is it possible?

 

[Michael M]

How about

Sub test()
Dim cell As Range, x As Integer
x = 0
For Each cell In Range("C2:C" & Cells(Rows.Count, "D").End(xlUp).Row)
    If cell.Value <> "" Then
    MsgBox cell.MergeArea(1).Value & " has " & cell.MergeArea.Count & " merged rows"
     x = x + 1
End If
Next
 MsgBox "There are " & x & " Groups !!"
End Sub

 

[airforceone]

How about

Sub test()
Dim cell As Range, x As Integer
x = 0
For Each cell In Range("C2:C" & Cells(Rows.Count, "D").End(xlUp).Row)
    If cell.Value <> "" Then
    MsgBox cell.MergeArea(1).Value & " has " & cell.MergeArea.Count & " merged rows"
     x = x + 1
End If
Next
 MsgBox "There are " & x & " Groups !!"
End Sub

simplicity is beauty thanks @Michael M

 

[Michael M]

Glad to help...