Search code examples
vba

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


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.


Solution

  • 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