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.
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