Try this:

Code:
Sub LMP_Test()

    Dim rngData                     As Range
    Dim rngFirstValue               As Range
    Dim rngValue                    As Range
    Dim varResult()                 As Variant
    Dim strFindWhat                 As String
    Dim lngCount                    As Long
    
    Const strShtName                As String = "calcs"
    Const strDataStartCell          As String = "C4"
    Const strCriteriaCell           As String = "D11"
    Const strResultCell             As String = "C15"
    Const strBlankArrayVal          As String = "ArrayIsBlankWithNoDataFound"
    
    With Worksheets(strShtName)
        Set rngData = .Range(strDataStartCell).CurrentRegion
        strFindWhat = .Range(strCriteriaCell).Value
        With rngData.Resize(, 1)
            Set rngValue = .Find(strFindWhat, LookIn:=xlValues)
            If Not rngValue Is Nothing Then
                Set rngFirstValue = rngValue
                Set rngValue = Nothing
                lngCount = 1
                ReDim varResult(1 To lngCount)
                varResult(LBound(varResult)) = strBlankArrayVal
                Do
                    If rngValue Is Nothing Then
                        Set rngValue = .FindNext(rngFirstValue)
                        varResult(lngCount) = rngValue.Offset(, 1).Value
                    Else
                        lngCount = lngCount + 1
                        Set rngValue = .FindNext(rngValue)
                        ReDim Preserve varResult(1 To lngCount)
                        varResult(lngCount) = rngValue.Offset(, 1).Value
                    End If
                Loop While Not rngValue Is Nothing And rngValue.Address <> rngFirstValue.Address
            End If
        End With
        If varResult(LBound(varResult)) <> strBlankArrayVal Then
            .Range(strResultCell).Resize(10000).ClearContents
            varResult = Application.Transpose(varResult)
            .Range(strResultCell).Resize(UBound(varResult), 1).Value = varResult
        End If
    End With
    
    Set rngData = Nothing
    Set rngFirstValue = Nothing
    Set rngValue = Nothing
    Erase varResult
    strFindWhat = vbNullString
    lngCount = Empty

End Sub