Finding the factors of a number

mortgageman

Well-known Member
Joined
Jun 30, 2005
Messages
2,015
I am working on a spreadsheet for my 6th grader. Does anyone out there have a UDF that generates all the factors of a number? (Yeah I know I could write it, but I hate to reinvent the wheel. If it is out there, I would appreciate it)

Gene, "The Mortgage Man", Klein
 

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

dantb

Active Member
Joined
Mar 20, 2002
Messages
358
This Came from Microsoft and seems to work. Dan

Sub GetFactors()
Dim Count As Integer
Dim NumToFactor As Single 'Integer limits to < 32768
Dim Factor As Single
Dim y As Single
Dim IntCheck As Single

Count = 0
Do
NumToFactor = _
Application.InputBox(Prompt:="Type integer", Type:=1)
'Force entry of integers greater than 0.
IntCheck = NumToFactor - Int(NumToFactor)
If NumToFactor = 0 Then
Exit Sub
'Cancel is 0 -- allow Cancel.
ElseIf NumToFactor < 1 Then
MsgBox "Please enter an integer greater than zero."
ElseIf IntCheck > 0 Then
MsgBox "Please enter an integer -- no decimals."
End If
'Loop until entry of integer greater than 0.
Loop While NumToFactor <= 0 Or IntCheck > 0
For y = 1 To NumToFactor
'Put message in status bar indicating the integer being checked.
Application.StatusBar = "Checking " & y
Factor = NumToFactor Mod y
'Determine if the result of division with Mod is without _
remainder and thus a "factor".
If Factor = 0 Then
'Enter the factor into a column starting with the active cell.
ActiveCell.Offset(Count, 0).Value = y
'Increase the amount to offset for next value.
Count = Count + 1
End If
Next
'Restore Status Bar.
Application.StatusBar = "Ready"
End Sub

Sub GetPrime()
Dim Count As Integer
Dim BegNum As Single 'Integer limits to < 32768
Dim EndNum As Single
Dim Prime As Single
Dim flag As Integer
Dim IntCheck As Single
Count = 0

Do
BegNum = _
Application.InputBox(Prompt:="Type beginning number.", Type:=1)
'Force entry of integers greater than 0.
IntCheck = BegNum - Int(BegNum)
If BegNum = 0 Then
Exit Sub
'Cancel is 0 -- allow Cancel.
ElseIf BegNum < 1 Then
MsgBox "Please enter an integer greater than zero."
ElseIf IntCheck > 0 Then
MsgBox "Please enter an integer -- no decimals."
End If
'Loop until entry of integer greater than 0.
Loop While BegNum <= 0 Or IntCheck > 0

Do
EndNum = _
Application.InputBox(Prompt:="Type ending number.", Type:=1)
'Force entry of integers greater than 0.
IntCheck = EndNum - Int(EndNum)
If EndNum = 0 Then
Exit Sub
'Cancel is 0 -- allow Cancel.
ElseIf EndNum < BegNum Then
MsgBox "Please enter an integer larger than " & BegNum
ElseIf EndNum < 1 Then
MsgBox "Please enter an integer greater than zero."
ElseIf IntCheck > 0 Then
MsgBox "Please enter an integer -- no decimals."
End If
'Loop until entry of integer greater than 0.
Loop While EndNum < BegNum Or EndNum <= 0 Or IntCheck > 0

For y = BegNum To EndNum
flag = 0
z = 1
Do Until flag = 1 Or z = y + 1
'Put message into Status Bar indicating the integer and _
divisor in each loop.
Application.StatusBar = y & " / " & z
Prime = y Mod z
If Prime = 0 And z <> y And z <> 1 Then
flag = 1
End If
z = z + 1
Loop

If flag = 0 Then
'Enter the factor into a column starting with the active cell.
ActiveCell.Offset(Count, 0).Value = y
'Increase the amount to offset for next value.
Count = Count + 1
End If
Next y
'Restore Status Bar.
Application.StatusBar = "Ready"
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,118,455
Messages
5,572,229
Members
412,448
Latest member
ManuW
Top