• Home
 · 
• Miscellaneous
 · 
• This finds friendly numbers. There are two numbers. The program takes the integral factors of each

This finds friendly numbers. There are two numbers. The program takes the integral factors of each

This finds friendly numbers. There are two numbers. The program takes the integral factors of each number that it uses in a count thing and

API Declarations




Dim lngAnswer As Long
Dim blnFound As Boolean
Dim lngCount As Long
Dim lngAnswer1 As Long
Dim lngAnswer2 As Long
Dim intStop As Integer
Dim strStop1 As String
Dim intStop1 As Integer
Dim lngCount2 As Long



Rate This finds friendly numbers. There are two numbers. The program takes the integral factors of each

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

strStop1 = InputBox("Please enter the number of friendly numbers you would like to find, from 1 to 30.", "Startup")
If strStop1 = "" Then
    End
ElseIf strStop1 > 30 Then
    MsgBox "That number is too high to be calculated.  Please restart the form", vbOKOnly, "Too High"
    End
End If
intStop1 = strStop1
intStop = 0
lngCount = 0
blnFound = False
LblAnswer.Caption = ""
Do Until blnFound = True
    lngCount = lngCount + 1
    Call Find(lngCount, lngAnswer)
    If lngAnswer >= lngCount Then
        lngAnswer1 = lngAnswer
        Find lngAnswer, lngAnswer2
        blnFound = Friendly(lngAnswer1, lngAnswer2, lngCount, lngAnswer)
        If blnFound = True Then
            LblAnswer.Caption = LblAnswer.Caption & "The numbers " & lngCount & " and " & lngAnswer & " are friendly numbers."
            intStop = intStop + 1
        End If
    End If
    If blnFound = True Then
        blnFound = False
        LblAnswer.Caption = LblAnswer.Caption & vbCrLf
        If intStop >= intStop1 Then
            blnFound = True
            MsgBox "The quest to find the first " & intStop & " friendly numbers comes to a stop.", vbOKOnly, "Done"
        End If
    End If
Loop
End Sub

Sub Find(ByVal lngNum As Long, lngSum As Long)
lngSum = 0
For lngCount2 = 1 To lngNum - 1
    If (lngNum Mod lngCount2) = 0 Then
        lngSum = lngSum + lngCount2
    End If
Next lngCount2
End Sub

Function Friendly(ByVal lngSum1 As Long, lngSum2 As Long, lngNum1 As Long, lngNum2 As Long) As Boolean
Friendly = False
If lngSum1 = lngNum2 And lngSum2 = lngNum1 Then
    Friendly = True
End If
If lngNum1 = lngNum2 Then
    Friendly = False
End If
End Function

Private Sub CmdPrint_Click()
PrintForm
End Sub

Private Sub CmdQuit_Click()
Unload Me
End Sub