Egen function beregner ikke!!

Har følgende function:

Option Explicit
Dim rKol As Range
Dim rCol As Range
Dim iMonth As Integer
Dim iKvartal As Integer
Dim sKriterium As String
Dim rCell As Range
Function TaelKvartal(Område As Range, Kvartal As Integer, Kriterium As String) As Integer
    Set rKol = Område
    iKvartal = Kvartal
    sKriterium = Kriterium
    Select Case iKvartal
        Case 1
            iMonth = 4
            Set rCol = Range("B3")
            For Each rCell In rKol
                If Month(rCell.Value) < iMonth Then
                    Set rCol = Range(rCol, rCell)
                End If
            Next rCell
        Case 2
            iMonth = 3
            Set rCol = Range("B3")
            For Each rCell In rKol
                If Month(rCell.Value) < iMonth + 1 Then
                Else
                    Set rCol = rCell
                    Exit For
                End If
            Next rCell
            For Each rCell In rKol
                If Month(rCell.Value) > iMonth Then
                    Set rCol = Range(rCol, rCell)
                End If
            Next rCell
        Case 3
            iMonth = 10
            Set rCol = Range("E3")
            For Each rCell In rKol
                If Month(rCell.Value) < iMonth Then
                    Set rCol = Range(rCol, rCell)
                End If
            Next rCell
        Case 4
            iMonth = 9
            Set rCol = Range("E3")
            For Each rCell In rKol
                If Month(rCell.Value) < iMonth + 1 Then
                Else
                    Set rCol = rCell
                    Exit For
                End If
            Next rCell
            For Each rCell In rKol
                If Month(rCell.Value) > iMonth Then
                    Set rCol = Range(rCol, rCell)
                End If
            Next rCell
    End Select
    TaelKvartal = 0
    For Each rCell In rCol
        If rCell.Offset(0, 1).Value = sKriterium Then TaelKvartal = TaelKvartal + 1
    Next
End Function

Problem den ny beregner ikke ved ændringer i regnearket

arket har følgende data

        A        B      C    Osv
1    Uge    Dato  +/-
2
3    1      03-01  +
2    2      10-01    -
osv

Ønsker at tælle + kvatals-vis 1. halvår er i b og c 2. er i e og f

evt en løsning med indbyggede functioner

Mvh Jan