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