How to correctly countif strings nostrikethrough

[Nay83]

Dear all,
i like to know how to count correctly for 4 questions in C43 to C46. Which formula (or) VBA code will answer and which one should i use in "yellow color" filled cells in column D and G in attached image.
I tested and used the followings module 1 to 4 as below in attached image file. But, i cannot correctly count which i needed.
Thanks in advance for your expertise and knowledge sharing.

Module 1: Count NO strikethorugh text
Function CountNoStrikeThrough(r As Range) As Long
Application.Volatile
Dim c As Range, d As Long
For Each c In r
If c <> "" Then
If c.Font.Strikethrough = False Then d = d + 1
End If
Next c
CountNoStrikeThrough = d
End Function
Module 2: Count strikethrough cells (My notes: it is not working correctly if cells are merged)
Public Function CountStrike(pWorkRng As Range) As Long
'Update 20140819
Application.Volatile
Dim pRng As Range
Dim xOut As Long
xOut = 0
For Each pRng In pWorkRng
If pRng.Font.Strikethrough Then
xOut = xOut + 1
End If
Next
CountStrike = xOut
End Function
Module 3: Count Without Strikethrough Cells (My notes: it is not working correctly if cells are merged)
Public Function CountNoStrike(pWorkRng As Range) As Long
'Update 20140819
Application.Volatile
Dim pRng As Range
Dim xOut As Long
xOut = 0
For Each pRng In pWorkRng
If Not pRng.Font.Strikethrough Then
xOut = xOut + 1
End If
Next
CountNoStrike = xOut
End Function
Module 4: Sum exclude strikethrough cells (My notes: it is only work with "numbers")
Public Function ExcStrike(pWorkRng As Range) As Long
'Update 20140819
Application.Volatile
Dim pRng As Range
Dim xOut As Long
xOut = 0
For Each pRng In pWorkRng
If Not pRng.Font.Strikethrough Then
xOut = xOut + pRng.Value
End If
Next
ExcStrike = xOut
End Function

 

[mumps]

You should avoid using merged cells at all cost because they almost always create problems for macros. If you need larger row heights, simply expand the row rather than merging the cells vertically. Instead of merging cells horizontally, you could expand the columns or do a little research into "CenterAcrossSelection". This has the same visual effect as merging cells horizontally without actually merging them. If you are willing to work without the merged cells, please let me know and I can suggest a solution for you. Also, will the number of activities in column C always be 9 or can that vary? Will Column B always contain the module numbers?

 

[Nay83]

You should avoid using merged cells at all cost because they almost always create problems for macros. If you need larger row heights, simply expand the row rather than merging the cells vertically. Instead of merging cells horizontally, you could expand the columns or do a little research into "CenterAcrossSelection". This has the same visual effect as merging cells horizontally without actually merging them. If you are willing to work without the merged cells, please let me know and I can suggest a solution for you. Also, will the number of activities in column C always be 9 or can that vary? Will Column B always contain the module numbers?

Thanks a lot. Number of activities in column C will vary, not always 9, no fixed range. I am adding module numbers in column B for your easy reference (what i used) linking with my post. I will avoid using merged cells. Look forward to your reply. :D

 

[Nay83]

Thanks a lot. Number of activities in column C will vary, not always 9, no fixed range. I am adding module numbers in column B for your easy reference (what i used) linking with my post. I will avoid using merged cells. Look forward to your reply. :D

Row 30 to Row 41 didn't need it. i just mentioned what i did but I cannot find the right answer what i need on D43 to D46 (if cells are not merged).

 

[mumps]

Nay83.xlsm
	B	C	D	E	F	G
20	#	Activity	Status			Status
21	1	xxxxxxx	Accomplished			Accomplished
22	2	xxxxxxx	Not Started Yet			Accomplished
23	3	xxxxxxx	In Progress			Accomplished
24	4	xxxxxxx	In Progress			Delayed
25	5	xxxxxxx	Delayed			Delayed
26	6	xxxxxxx	Delayed			Accomplished
27	7	xxxxxxx	Accomplished			Not Started Yet
28	8	xxxxxxx	Not Stared Yet			Not Started Yet
29	9	xxxxxxx	Accomplished			In Progress
30
31		Count NO Striketrough (Accomplished)
32		Count NO Striketrough (In Progress)
33		Count NO Striketrough (Not Started Yet)
34		Count NO Striketrough (Delayed)
Sheet1

Based on the data as shown above, try this macro:

Sub Nay83()
    Application.ScreenUpdating = False
    Dim bottomB As Long, status As Range, fnd As Range, cnt As Long, arr As Variant, i As Long
    arr = Array("Accomplished", "Not Started Yet", "In Progress", "Delayed")
    bottomB = Range("B" & Rows.Count).End(xlUp).Row
    For i = LBound(arr) To UBound(arr)
        Range("B20:D" & bottomB).AutoFilter Field:=3, Criteria1:=arr(i)
        For Each status In Range("D21:D" & bottomB).SpecialCells(xlCellTypeVisible)
            If status.Font.Strikethrough = True Then
                cnt = cnt + 1
            End If
        Next status
        Set fnd = Range("C:C").Find(arr(i), LookIn:=xlValues, lookat:=xlPart)
        fnd.Offset(, 1) = cnt
        cnt = 0
        Range("B1").AutoFilter
        Range("B20:G" & bottomB).AutoFilter Field:=6, Criteria1:=arr(i)
        For Each status In Range("G21:G" & bottomB).SpecialCells(xlCellTypeVisible)
            If status.Font.Strikethrough = True Then
                cnt = cnt + 1
            End If
        Next status
        Set fnd = Range("C:C").Find(arr(i), LookIn:=xlValues, lookat:=xlPart)
        fnd.Offset(, 4) = cnt
        Range("B1").AutoFilter
    Next i
    Application.ScreenUpdating = True
End Sub