PDA

View Full Version : Help with vba



VLynn
11-17-2016, 07:47 PM
Hello,

I'm looking for a macro that I can run and it will give me the common factors of a set of numbers between 10 and 80. Where I work, I deal with numbers a lot and I'm trying to find and easier way to find common factors. For example: I have 5 different number that are 2400, 1400, 1200, 1000, and 200. I need to find the common factors between 10 and 80 of these numbers. If I have a set of number that do not have a common factor between 10 and 80 I need the output as something like "None" or something similar. Below is the macro I have now that I found somewhere a couple weeks ago. But I would like to enter more then one number and for it to filter the output between 10 and 80.

--------------------------------------------------------------


Sub Common_Factors()
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


---------------------------------------------------

Thanks,
Lynn

mancubus
11-18-2016, 02:54 AM
welcome to the forum. please use code tags when posting your code. (see my signature.)

uploading your workbook will help resolve your requirement. (see my signature.)


test with a blank worksheet



Sub vbax_57757_common_factors()

Dim NumbersCF
Dim LN As Long, UN As Long, j As Long
Dim tmpArr

LN = 10
UN = 80

NumbersCF = Array(2400, 1400, 1200, 1000, 200, 3, 8, 12)

For j = LBound(NumbersCF) To UBound(NumbersCF)
tmpArr = FactorsOfANumber(CDbl(NumbersCF(j)), LN, UN)
If UBound(tmpArr) = -1 Then
Cells(1, j + 1).Value = "None"
Else
Cells(1, j + 1).Resize(UBound(tmpArr) + 1).Value = Application.Transpose(tmpArr)
End If
Next j

End Sub


uses following UDF


Function FactorsOfANumber(NumToChk As Double, LowerNum As Long, UpperNum As Long) As Variant
'vbax_57757

Dim Num As Long
Dim FactorsList As String

For Num = LowerNum To UpperNum
If Int(NumToChk / Num) = (NumToChk / Num) Then
FactorsList = FactorsList & "," & Num
End If
Next Num

FactorsOfANumber = Split(Mid(FactorsList, 2), ",")

End Function

SamT
11-18-2016, 09:07 AM
Do you want every factor or just the Primes? ie: 2400 if factorable by 1, 2, 3, 4, 5, 6, 8, 10, 12, 15, 16. . . . 2400

If only the Primes are needed, the Factors are 2, 3, and 5.

Note that the Prime Factors of all numbers will be smaller the the Square root of the number. The SqRt of 2400 is less than 50, so the only possible Prime factors of all numbers less than 2400 are 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, and 47.

SamT
11-18-2016, 02:17 PM
Public Function First100Primes() As Variant
'An Array of arrays. (10 each of 10 values)

Dim FactorialsTo_960, FactorialsTo_5238, FactorialsTo_16128, FactorialsTo_32040
Dim FactorialsTo_54288, FactorialsTo_80088, FactorialsTo_124608, FactorialsTo_218088
Dim FactorialsTo_292680, FactorialsTo_299208

FactorialsTo_960 = Array(2, 3, 5, 7, 11, 13, 17, 19, 23, 29) 'to 960
FactorialsTo_5238 = Array(31, 37, 41, 43, 47, 53, 59, 61, 67, 71) 'to 5,328
FactorialsTo_16128 = Array(73, 79, 83, 89, 97, 101, 103, 107, 109, 113) 'to 16,128
FactorialsTo_32040 = Array(127, 131, 137, 139, 149, 151, 157, 163, 167, 173) 'to 32,040
FactorialsTo_54288 = Array(179, 181, 191, 193, 197, 199, 211, 223, 227, 229) 'to 54,288 '181 factors all Excel Integers
FactorialsTo_80088 = Array(233, 239, 241, 251, 257, 263, 269, 271, 277, 281) 'to 80,088
FactorialsTo_124608 = Array(283, 293, 307, 311, 313, 317, 331, 337, 347, 349) 'to 124,608
FactorialsTo_218088 = Array(353, 359, 367, 373, 379, 383, 389, 397, 401, 409) 'to 218,088
FactorialsTo_292680 = Array(419, 421, 431, 433, 439, 443, 449, 457, 461, 463) 'to 292,680
FactorialsTo_299208 = Array(467, 479, 487, 491, 499, 503, 509, 521, 523, 541) 'to 299,208

First100Primes = Array(FactorialsTo_960, FactorialsTo_5238, FactorialsTo_16128, FactorialsTo_32040, _
FactorialsTo_54288, FactorialsTo_80088, FactorialsTo_124608, FactorialsTo_218088, _
FactorialsTo_292680, FactorialsTo_299208)
End Function


Sub Example_Usage_First100Primes()
Dim x, y
x = First100Primes

y = x(0)
MsgBox y(0)

y = x(9)
MsgBox y(9)
End Sub

The first 1000 Prime Numbers will factor a little over the first 62,000,000 integers.

VLynn
11-18-2016, 02:33 PM
Hi mancubus,

Sorry, I should have read about uploading the attachment and posting the code first. Thank you for your code above, I'm not real good with vba but trying to learn. I love learning about coding! But anyways, I tried the code above and it automatically puts in the factors of 2400, 1400, 1200, 1000, and 200. I do like the LowerNum to UpperNum, this is what I was looking for to narrow the output down to between 10 and 80. But my numbers change with each packet that I get. I attached my workbook that I was working on. I would like to add your LowerNum to UpperNum function like you have it above between, 10 and 80. But I would like to be able to put more than one number in the box when I run the macro. Right now, when I run the macro a box pops up and I can only add one number to the box. I usually have about 4 to 5 sets of numbers per packet and numbers change from one packet to another. I also need it to filter out the common factors of those numbers. If there is no common factor then the output be something like "None". I work in a cutting factory for garments so I have to figure out how many ply to cut material at, with each packet, to get the best yield to save on material.

Thanks again for all your help

Lynn

VLynn
11-18-2016, 02:38 PM
Hi SamT,

I need all factors of a set of numbers but only between 10 and 80. Like say if I was using 400... the factors I would need is 10, 16, 20, 25, 40, 50, and 80. I usually have around 4 to 5 different numbers in a packet so I would need the common factors of those sets of numbers. Thanks for the code above, I just logged on so I will check yours out too.

Thanks,
Lynn

SamT
11-18-2016, 03:57 PM
This requires you to put all the numbers in the group in Row 1 of any worksheet in this workbook, then run the macro "FindCommonFactors." the results will be shown as noted on sheet 1. You can add sheets if you wish. The macro always runs against the ActiveSheet.

Here's the code

Sub FindCommonFactors()

Const SmallestFactor As Long = 10
Const LargestFactor As Long = 80

Dim i As Long
Dim f As Long
Dim SmallestNumber As Long
Dim NumberGroup As Range
Dim CommonFactors As New Collection
Dim Results As Range

With ActiveSheet
Set NumberGroup = Range(.Range("A1"), .Cells(1, Columns.Count).End(xlToLeft))

SmallestNumber = WorksheetFunction.Min(Array(NumberGroup))

For f = SmallestFactor To LargestFactor
If SmallestNumber Mod f = 0 Then CommonFactors.Add f, CStr(f)
Next

For i = 1 To NumberGroup.Count
For f = CommonFactors.Count To 1 Step -1
If NumberGroup(i) Mod CommonFactors(f) <> 0 Then CommonFactors.Remove (f)
If CommonFactors.Count = 0 Then GoTo NoneFound
Next
Next

Set Results = .Range("B3").Resize(CommonFactors.Count)
For f = 1 To CommonFactors.Count
Results(f) = CommonFactors(f)
Next


Exit Sub
NoneFound:
.Range("B3") = "No Common Factors Found"
End With
End Sub

Since you might want to change the Fator spread from time to time, just change the valuse of

Const SmallestFactor As Long = 10
Const LargestFactor As Long = 80

VLynn
11-18-2016, 05:46 PM
It works perfect thank you so much. One question though... when I put two number in that do not have a common factor it gives me these errors:

17648

17649



Is there something else I need to do?

Thanks,
Lynn


This requires you to put all the numbers in the group in Row 1 of any worksheet in this workbook, then run the macro "FindCommonFactors." the results will be shown as noted on sheet 1. You can add sheets if you wish. The macro always runs against the ActiveSheet.

Here's the code

Sub FindCommonFactors()

Const SmallestFactor As Long = 10
Const LargestFactor As Long = 80

Dim i As Long
Dim f As Long
Dim SmallestNumber As Long
Dim NumberGroup As Range
Dim CommonFactors As New Collection
Dim Results As Range

With ActiveSheet
Set NumberGroup = Range(.Range("A1"), .Cells(1, Columns.Count).End(xlToLeft))

SmallestNumber = WorksheetFunction.Min(Array(NumberGroup))

For f = SmallestFactor To LargestFactor
If SmallestNumber Mod f = 0 Then CommonFactors.Add f, CStr(f)
Next

For i = 1 To NumberGroup.Count
For f = CommonFactors.Count To 1 Step -1
If NumberGroup(i) Mod CommonFactors(f) <> 0 Then CommonFactors.Remove (f)
If CommonFactors.Count = 0 Then GoTo NoneFound
Next
Next

Set Results = .Range("B3").Resize(CommonFactors.Count)
For f = 1 To CommonFactors.Count
Results(f) = CommonFactors(f)
Next


Exit Sub
NoneFound:
.Range("B3") = "No Common Factors Found"
End With
End Sub

Since you might want to change the Fator spread from time to time, just change the valuse of

Const SmallestFactor As Long = 10
Const LargestFactor As Long = 80

Aussiebear
11-18-2016, 06:12 PM
It works perfect thank you so much. One question though... when I put two number in that do not have a common factor

Sorry but I don't understand this as every whole number has at least one common factor. If you are meaning that the common factor does not fit within the defined range then we will simply need to add an error checking function to return a msg "No Factors within defined range"

VLynn
11-18-2016, 06:24 PM
Sorry, I guess I should have explained better. I was meaning, such as 97 and 89, the only common factor is 1 so this is not between 10 and 80. What do I have to do to have it to return the message "No Factors within defined range. So yeah I mean that the common factor does not fit within the defined range.

Thanks


Sorry but I don't understand this as every whole number has at least one common factor. If you are meaning that the common factor does not fit within the defined range then we will simply need to add an error checking function to return a msg "No Factors within defined range"

SamT
11-18-2016, 07:01 PM
add an If...Then...Else here

Set Results = .Range("B3").Resize(CommonFactors.Count)


If CommonFactors.Count > 1 Then
Set Results = .Range("B3")
Else
Set Results = .Range("B3").Resize(CommonFactors.Count)
End If


And you might as well add a line here

Set NumberGroup = Range(.Range("A1"), .Cells(1, Columns.Count).End(xlToLeft))

Range(.Range("B3"), .Range("B3").End(xlDown)).ClearContents
Set NumberGroup = Range(.Range("A1"), .Cells(1, Columns.Count).End(xlToLeft))


There is a bug in the code that you can avoid. Do NOT put a number smaller than SmallestFactor, (10 at this time,) in Cell A1. There is more to the bug than that, but that will prevent the bug from triggering.

SamT
11-18-2016, 09:52 PM
Try this one. I fixed that bug.