How do I find every number with two 3s and two 7s in a list of 60501 numbers using VBA?

Question

I need to find all the numbers with two 3s and two 7s in any order from a list of 65000 sequential numbers from 10000 to 65000 in the first column of a spreadsheet.

Here is the code so far:

Sub VBA_Loop_through_Rows()
Dim w As Range
Dim threeCount As Integer
Dim fourCount As Integer
For Each w In Range("A1001:AC70435").Rows
    threeCount = 0
    sevenCount = 0
    If Left(w.Cells(1), 1) = "3" Then
        threeCount = threeCount + 1
    End If
    If Left(w.Cells(1), 1) = "7" Then
        sevenCount = sevenCount + 1
    End If
    If Left(w.Cells(1), 2) = "3" Then
        threeCount = threeCount + 1
    End If
    If Left(w.Cells(1), 2) = "7" Then
        sevenCount = sevenCount + 1
    End If
    If Left(w.Cells(1), 3) = "3" Then
        threeCount = threeCount + 1
    End If
    If Left(w.Cells(1), 3) = "7" Then
        sevenCount = sevenCount + 1
    End If
    If Left(w.Cells(1), 4) = "3" Then
        threeCount = threeCount + 1
    End If
    If Left(w.Cells(1), 4) = "7" Then
        sevenCount = sevenCount + 1
    End If
    If Left(w.Cells(1), 5) = "3" Then
        threeCount = threeCount + 1
    End If
    If Left(w.Cells(1), 5) = "7" Then
        sevenCount = sevenCount + 1
    End If
    If threeCount > 1 Then
        Debug.Print w.Cells(1)
        Debug.Print threeCount
        Debug.Print sevenCount
    End If
Next
End Sub

This does not produce the right result. I think the problem is trying to manipulate a number with a string function. But changing the format in Excell from general to text does not solve the problem. Perhaps first dividing by 10,000 and truncating the result, then doing the same sort of reduction sequentially would help.

Answer 1

It's unclear to me if you're just looping through rows or if you're just interested in the numbers. Either way you'll probably need to use the Convert To String method Cstr as shown below. You can also reduce your amount of code considerably by looping through the number turned into a string (vs. Left continually for each position)

Lastly... do not use Integer as you are going to exceed the maximum value for an integer data type when grabbing 3s (and it's not best practice).

Sub findNumbers()
Dim i As Long, g As Long, t As String, threeCounter  As Long, sevenCounter As Long, w As Range

For Each w In Range("A1000:A65000").Cells

      t = CStr(w.Value)
      
      For g = 1 To Len(t)
         If Mid(t, g, 1) = "3" Then
            threeCounter = threeCounter + 1
         ElseIf Mid(t, g, 1) = "7" Then
            sevenCounter = sevenCounter + 1
         End If
         
      Next g
         
Next w

MsgBox "Count of three's..." & CStr(threeCounter)
MsgBox "Count of 7evens's..." & CStr(sevenCounter)

End Sub

Answer 2

Here is a different approach. Assemble the possible results and remove non-matches. It also illustrates iterating over collections in reverse so as to not run into trouble with indexes.

Option Explicit

Const lim As Long = 65000

Sub Main()

    Dim c As Long
    Dim results As New Collection '1-based!
    c = 0
    
    'construct collection of strings to inspect
    Do While c < lim
        c = c + 1
        'anything below 13377 and above 63377 cannot be a result
        If c > 13377 And c < 63378 Then
            results.Add CStr(c) 'create list of strings, not numbers
        End If
    Loop

    Dim i As Long
    
    'remove all results not containing exactly 2 "3"s
    For i = results.Count To 1 Step -1
        If CountCharacter(results(i), "3") <> 2 Then
            results.Remove i
        End If
    Next i
    
    'remove all results not containing exactly 2 "7"s
    ' notice that there is performance benefit because we now only
    ' have to evaluate the strings that we know already contain two "3"'3
    For i = results.Count To 1 Step -1
       If CountCharacter(results(i), "7") <> 2 Then
            results.Remove i
        End If
    Next i
    
    For i = 1 To results.Count
        Debug.Print results(i)
    Next i
End Sub

Function CountCharacter(SearchString As String, Characters As String) As Integer
    'either method can be used to find the number of occurences of a substring
    'I did not experience a performance difference but I also did not investigate
    'uncomment to your preference
    'CountCharacter = (Len(SearchString) - Len(Replace(SearchString, Characters, ""))) / Len(Characters)
    CountCharacter = UBound(Split(SearchString, Characters))
End Function