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.

[LaVolpe]

1st recommendation: don't use strings. Your array is an integer converted to a formatted string. Comparing strings is far slower than comparing numbers. If your array were numbers, comparison would be much faster, and when you need to display the number, then display it with: Right$("000" & arrResult(i))

2nd recommendation. Sort the array, if sorted array has no adverse effect in your project. If sorted and when counting, and you find a match, you know you can stop looping once the match is no longer found. Example if sorted numbers: 1, 2, 3, 3, 4. Once you find the first 3, when you hit 4, you can prematurely exit your search loop.

3rd recommendation: If sorting the array, you can use a binary search routine to locate a match in the array faster than any other algorithm on this planet. Binary searches in a sorted array cannot be beat for speed. A binary search can find a matching item in a 1,000,000 item array in 20 iterations or less.

Recommendations 2 & 3 will require a sort and binary search routine to be added to your project. There are various sort routines you can use. If sorted arrays sound like something you want to mess with. Here is a link by Ellis Dee that shows several methods.

If for some reason you don't want to apply any of the above recommendations, this should speed it up a little, but probably not that much:

Change:
Private Function getCountofNum(ByVal iNum As Integer) As Integer
To:
Private Function getCountofNum(ByVal iNum As String) As Integer

By changing iNum as a string parameter, you are at least comparing strings to strings in your counting loop. By leaving it as a number, VB is converting string to number or number to string to do the comparisons in your IF statement.

Last but not least? You are creating two 5000 item arrays: arrNum & arrNum2, but after the command1_click event, they aren't being used any longer (from what you posted). If that is the case, you may want to erase those arrays. It won't speed up your code, but why keep that much memory reserved/used if not needed.

Hope the above helps.

Edited: Another solution without sorting or using a binary search algorithm...
Though this idea means you'd have a another 10,000 item array laying around, you can precount your arrSource in command1. I'll leave the arrays as strings, but still think you'd be better off using numbers instead.

Private Const CountLimit = 2
Private arrNum() As String ' changed
Private arrNum2() As String 'changed
Private arrSource() As String
Private arrCount() As Integer ' << new
.....
Private Sub Command1_Click()
    Dim j As Long, i As Integer ' changed
    Dim tmpStr As String
    tmpStr = Join(arrNum, "-") & "-" & Join(arrNum2, "-")
    arrSource = Split(tmpStr, "-")
    Erase arrNum ' added, erase only if not needed again
    Erase arrNum2 ' added, erase only if not needed again
    ReDim arrCount(UBound(arrResult)) ' added
    For j = 0 To UBound(arrSource)  ' loop added; now arrCount has your counts
          i = CInt(arrSource(j)
          arrCount(j) = arrCount(j) + 1
    Next
    Call CountNum
End Sub

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

And, if arrNum & arrNum2 are not required, no command1_click needed; all can be done in form_load or in a separate routine called by form_load:

Private Sub Form_Load()
    Dim i As Long, j As Integer
    ReDim arrResult(9999)
    ReDim arrCount(9999)
    For i = 0 To 4999
        arrResult(i) = Right$("000" & i, 4)
        J = CInt(Rnd * i)
        arrResult(i + 5000) = Right$("000" & J, 4)
        arrCount(i) = arrCount(i) + 1
        arrCount(J) = arrCount(J)+1
    Next
End Sub

Edited yet again: The line arrCount(i) = arrCount(i) + 1 is not needed either. You know the count will always be at least one.
Also, in form_load, ensure you add the statement: Randomize
Otherwise, your random integers will always be the same pattern each time you run your app.
To see what I mean, in a new project: Add a message box to a button click event: MsgBox Cint(Rnd*10000)
Run the project 3 times, you will get the same number all 3 times. Now add Randomize in the form_load event and try again; you won't get the same number all 3 times.

[standardusr]

Thank you very much LaVolpe