The code below supports three functions, which can be used either from other VBA code or as User Defined Functions.
The first function getFactors(NumberToFactor) returns an array containing all the factors of the argument.
The next, getPrimeFactors(NumberToFactor) returns an array containing all the prime factors of the argument. Note that it returns each factor only once so that the prime factors of 12 are 1, 2, and 3 (and not 1, 2, 2, and 3).
The third function IsPrime(aNumber) returns True or False indicating whther the number is a prime number.
The function getFactors uses the Dictionary object that is supported by the Windows Scripting library.
The code has been tested but not exhaustively. Exercise your discretion in using it. The code goes in a standard VBA module.
Option Explicit
Option Base 0
#Const EarlyBind = False
Function GetFactors(ByVal NumToFactor As Long)
'Returns all the factors of the argument NumToFactor. _
No factor is repeated and the factors are in no particular _
order.
'Usage: Select an appropriate number of cells in a single row _
and enter the formula as an array formula. If insufficient _
cells are selected, the function returns a negative value _
indicating how many cells are actually needed. _
Hence, if one array-enters =GetFactors(12) in a range of 2 _
cells, the function will return -6 indicating it should be _
array entered in 6 cells in a row. _
To use the function in a single column use it at _
=TRANSPOSE(GetFactors(A1)), where A1 contains the number whose _
factors are desired.
'Implementation: The function uses the GetPrimeFactors to get _
all the prime factors of NumToFactor. It then checks to see _
which of the powers of each of the prime factors greater than 1 _
is a factor of NumToFactor. For each it finds, it returns two _
items, the power itself and the 'complement,' i.e., _
NumToFactor/Power-of-prime-factor.
'Example 1: In computing the factors of 12, the PrimeFactors _
returned are 1, 2, and 3. Hence, the factors are calculated _
as: _
By default, the routine includes 1 and 12. _
Then, for the prime factor 2, it checks for the powers of 2 _
starting with 1. For 2^1. it includes the factors 2 and 12/2^1 _
or 6. It does the same for 2^2 and thus includes 4 and 3. _
The next power 2^3 is too large and the code moves on to the next _
prime factor. _
For the prime factor 3, it does the same thing as above. 3^1 and _
12/3^1 would both be included as factors except that they have _
already been included. Since the code uses a Scripting.Dictionary _
object to store the factors, each duplicate raises an error that _
is ignored. Hence, the result is 1, 12, 2, 6, 4, and 3.
'Example 2: In computing the factors of 39, the PrimeFactors _
returned are 1, 3, and 13. Hence, the factors are calculated _
as: _
By default, the routine includes 1 and 39. _
Then, for the prime factor 3, it includes the factors 3^1 and _
39/3^1 or 13. The next power of 3, 3^2 is not a factor and is _
ignored. The next power 27 is too large and the code moves to the _
next prime factor, which happens to be 13. The code would have _
added 13 and 39/13 or 3 but they are already included. Since the _
code uses a Scripting.Dictionary object to store the factors, each _
duplicate factor raises an error that is ignored.
'Example 3: For 64, the prime factors returned are 1 and 2. _
The code automatically includes the factors 1 and 64. _
Then, for the prime factor 2, it goes through the powers of 2 (2, 4, _
8, 16, and 32) and adds each of them to the list of factors since _
each divides 64 exactly, as well as their complementary values, _
i.e., 32, 16, 8, 4, and 2, again relying on the scripting _
dictionary to filter out duplicates. Hence, the code returns the final _
result of 1, 64, 2, 32, 4, 16, and 8.
Dim PrimeFactors() As Long, I As Long, J As Long
#If EarlyBind Then
Dim Factors As Dictionary
#Else
Dim Factors As Object
#End If
If NumToFactor = 0 Then
Exit Function
ElseIf NumToFactor < 1 Then
GetFactors = "Argument must be an integer greater than zero."
Exit Function
End If
#If EarlyBind Then
Set Factors = New Dictionary
#Else
Set Factors = CreateObject("Scripting.Dictionary")
#End If
PrimeFactors = GetPrimeFactors(NumToFactor)
Factors.Add CStr(1), 1
Factors.Add CStr(NumToFactor), NumToFactor
For I = LBound(PrimeFactors) To UBound(PrimeFactors)
If PrimeFactors(I) > 1 Then
'1st prime factor will be 1 or in the event the selected range _
isn't large enough a negative number.
J = 1
Do
Dim OneFactor As Long
On Error Resume Next
OneFactor = PrimeFactors(I) ^ J
Factors.Add CStr(OneFactor), OneFactor
Factors.Add CStr(NumToFactor / OneFactor), _
NumToFactor / OneFactor
On Error GoTo 0
J = J + 1
Loop Until NumToFactor <= PrimeFactors(I) ^ J _
Or NumToFactor Mod (PrimeFactors(I) ^ J) <> 0
End If
Next I
If Not TypeOf Application.Caller Is Range Then
GetFactors = Factors.Items
ElseIf Application.Caller.Cells.Count < Factors.Count Then
GetFactors = -Factors.Count
Else
GetFactors = Factors.Items
End If
End FunctionFunction GetPrimeFactors(ByVal NumToFactor As Long)
'Returns the unique prime factors of NumToFactor. So, for _
the number 12 it returns 1, 2, and 3 and *not* 1, 2, 2, 3.
'For usage notes see the GetFactors function above.
Dim PrimeIdx As Long, PrimeFactors() As Long, _
I As Long
If NumToFactor = 0 Then
GetPrimeFactors = 0
Exit Function
ElseIf NumToFactor < 0 Then
GetPrimeFactors = "The argument must be an integer greater than zero."
Exit Function
End If
ReDim PrimeFactors(9)
PrimeFactors(0) = 1: PrimeIdx = 1
If IsPrime(NumToFactor) Then
PrimeFactors(1) = NumToFactor
ReDim Preserve PrimeFactors(1)
GetPrimeFactors = PrimeFactors
Exit Function
End If
If NumToFactor Mod 2 = 0 Then
PrimeFactors(PrimeIdx) = 2: PrimeIdx = PrimeIdx + 1
Do: NumToFactor = NumToFactor / 2: Loop Until NumToFactor Mod 2 <> 0
End If
I = 3
Do
If NumToFactor Mod I = 0 Then
If IsPrime(I) Then
PrimeFactors(PrimeIdx) = I: PrimeIdx = PrimeIdx + 1
If PrimeIdx = UBound(PrimeFactors) Then _
ReDim Preserve PrimeFactors(UBound(PrimeFactors) + 10)
Do: NumToFactor = NumToFactor / I: Loop Until NumToFactor Mod I <> 0
End If
End If
I = I + 2
Loop While NumToFactor > 1
ReDim Preserve PrimeFactors(PrimeIdx - 1)
If Not TypeOf Application.Caller Is Range Then
ElseIf Application.Caller.Cells.Count < PrimeIdx Then
PrimeFactors(0) = -PrimeIdx
End If
GetPrimeFactors = PrimeFactors
End Function
Function IsPrime(aNumber As Long) As Boolean
Dim I As Long
If aNumber = 0 Then
IsPrime = False
ElseIf aNumber < 0 Then
IsPrime = False
ElseIf aNumber = 2 Then
IsPrime = True
ElseIf aNumber Mod 2 = 0 Then
IsPrime = False
Else
IsPrime = True
For I = 3 To Fix(Sqr(aNumber) + 0.5) Step 2
If aNumber Mod I = 0 Then
IsPrime = False
Exit For
End If
Next I
End If
End Function