Please optimize my code.

[standardusr]

Dear all expert programmers,
I make small vb code to count number in array. But it is running slow. Please optimize my code to be fast.

Option Explicit
Private Const CountLimit = 2
Private arrNum(4999) As String
Private arrNum2(4999) As String
Private arrSource() As String
Private Function getCountofNum(ByVal iNum As Integer) As Integer
    Dim lngCount As Long
    Dim i As Integer
    For i = 0 To UBound(arrSource)
        If arrSource(i) = iNum Then
            lngCount = lngCount + 1
        End If
    Next
    getCountofNum = lngCount
End Function
Private Sub CountNum()
    Dim lngCount As Long
    Dim i As Long
    Dim arrResult() As Integer
    Dim tmpCount As Integer
    ReDim arrResult(CountLimit)
    For i = 0 To UBound(arrSource)
        tmpCount = getCountofNum(arrSource(i))
        If tmpCount <= CountLimit Then
            arrResult(tmpCount) = arrSource(i)
        End If
    Next
    For i = CountLimit To 0 Step -1
        Debug.Print "count " & i & vbCrLf & arrResult(i) & vbCrLf
    Next
End Sub

Private Sub Command1_Click()
    Dim j As Long
    Dim tmpStr As String
    tmpStr = Join(arrNum, "-") & "-" & Join(arrNum2, "-")
    arrSource = Split(tmpStr, "-")
    Call CountNum
End Sub

Private Sub Form_Load()
    Dim i As Long
    For i = 0 To 4999
        arrNum(i) = Right$("000" & i, 4)
        arrNum2(i) = Right$("000" & CInt(Rnd * i), 4)
    Next
End Sub

Thank you for all answers.