VBA, list of number which after divided with x value results whole number

[motilulla]

Hello,

I want a "list of numbers" which after divided with x value results whole number

Please for example see the sample image. In the column C I have entered value 211876 which I tried to divided with the numbers are in the column formula in D3 =C3/B3 copied down. Some result of the division is in decimals and others in whole number.

But I need a "list of number" which after divided with x value results whole number as shown in the columns G:H, list of numbers gives after division gives whole number are 1, 2, 4, 14, 23, 28, 46 47, 49, 92, 98... and continue....

Basically I need a macro, which can ask...
1st-input X value, in this given example x value is = 211876
2nd-divisor starting number, in this given example divisor starting value is = 1
After entering both vales display the result list as shown in the column G: H

*	A	B	C	D	E	F	G	H	I	J
1				Formula D3=C3/B3
2		Number	Value	Whole Number			Number	Value	Whole Number
3		1	211876	211876			1	211876	211876
4		2	211876	105938			2	211876	105938
5		3	211876	70625,33333			4	211876	52969
6		4	211876	52969			14	211876	15134
7		5	211876	42375,2			23	211876	9212
8		6	211876	35312,66667			28	211876	7567
9		7	211876	30268			46	211876	4606
10		8	211876	26484,5			47	211876	4508
11		9	211876	23541,77778			49	211876	4324
12		10	211876	21187,6			92	211876	2303
13		11	211876	19261,45455			98	211876	2162
14		12	211876	17656,33333
15		13	211876	16298,15385
16		14	211876	15134
17		15	211876	14125,06667
18		16	211876	13242,25
19		17	211876	12463,29412
20		18	211876	11770,88889
21		19	211876	11151,36842
22		20	211876	10593,8
23		21	211876	10089,33333
24		22	211876	9630,727273
25		23	211876	9212
26		24	211876	8828,166667
27		25	211876	8475,04
28		26	211876	8149,076923
29		27	211876	7847,259259
30		28	211876	7567
31		29	211876	7306,068966
32		30	211876	7062,533333
33		31	211876	6834,709677
34		32	211876	6621,125
35		33	211876	6420,484848
36		34	211876	6231,647059
37		35	211876	6053,6
38		36	211876	5885,444444
39		37	211876	5726,378378
40		38	211876	5575,684211
41		39	211876	5432,717949
42		40	211876	5296,9
43		41	211876	5167,707317
44		42	211876	5044,666667
45		43	211876	4927,348837
46		44	211876	4815,363636
47		45	211876	4708,355556
48		46	211876	4606
49		47	211876	4508
50		48	211876	4414,083333
51		49	211876	4324
52		50	211876	4237,52
53		51	211876	4154,431373
54		52	211876	4074,538462
55		53	211876	3997,660377
56		54	211876	3923,62963
57		55	211876	3852,290909
58		56	211876	3783,5
59		57	211876	3717,122807
60		58	211876	3653,034483
61		59	211876	3591,118644
62		60	211876	3531,266667
63		61	211876	3473,377049
64		62	211876	3417,354839
65		63	211876	3363,111111
66		64	211876	3310,5625
67		65	211876	3259,630769
68		66	211876	3210,242424
69		67	211876	3162,328358
70		68	211876	3115,823529
71		69	211876	3070,666667
72		70	211876	3026,8
73		71	211876	2984,169014
74		72	211876	2942,722222
75		73	211876	2902,410959
76		74	211876	2863,189189
77		75	211876	2825,013333
78		76	211876	2787,842105
79		77	211876	2751,636364
80		78	211876	2716,358974
81		79	211876	2681,974684
82		80	211876	2648,45
83		81	211876	2615,753086
84		82	211876	2583,853659
85		83	211876	2552,722892
86		84	211876	2522,333333
87		85	211876	2492,658824
88		86	211876	2463,674419
89		87	211876	2435,356322
90		88	211876	2407,681818
91		89	211876	2380,629213
92		90	211876	2354,177778
93		91	211876	2328,307692
94		92	211876	2303
95		93	211876	2278,236559
96		94	211876	2254
97		95	211876	2230,273684
98		96	211876	2207,041667
99		97	211876	2184,28866
100		98	211876	2162
101		99	211876	2140,161616
102		100	211876	2118,76
103
104

Thank you all.

I am using Excel 2000

Regards,
Moti

 

[Snakehips]

@motilulla Perhaps like this?

MRXLMAY21.xlsm
	G	H
2	Number	Value
3	1	2118770
4	2	2118770
5	5	2118770
6	10	2118770
7	211877	2118770
8	423754	2118770
9	1059385	2118770
10	2118770	2118770
Sheet6

Sub Factors()
Dim Num As Long
Dim F As Long
Dim r As Integer

On Error GoTo Out

Num = 1 * InputBox("Please enter a positive integer to be factorised.")
F = 1 * InputBox("Please enter a positive integer as first divisor.")
r = 3

Application.ScreenUpdating = False

Range("G:H").ClearContents
Range("G2") = "Number"
Range("H2") = "Value"

Do Until F > Num

If (Evaluate("MOD(" & Num & "," & F & ") = 0")) Then
Range("G3").Offset(OS, 0) = F
Range("G3").Offset(OS, 1) = Num
OS = OS + 1
End If

If F > Num Then Exit Do
F = F + 1
Loop

Out:
Application.ScreenUpdating = True
End Sub

It is taking something like 30 seconds per million iterations of the loop.
So the above example took 1min 5 sec.
Your original example takes 8 seconds.
It could no doubt be speeded up if using arrays.

Hope that helps.

 

[johnnyL]

Original numbers tested results in virtually instantaneous results with the following code:

Sub FindWholeNumbers()
'
    Dim DivisorIncrementer  As Long
    Dim RowCounter          As Long
    Dim StartingDivisor     As Long
    Dim Xvalue              As Long
'
    RowCounter = 3
'
    Xvalue = Application.InputBox("What is the X value?", "Whole Number Finder", Type:=1)
    If Xvalue = 0 Then Exit Sub
'
    StartingDivisor = Application.InputBox("What is the Divisor number to start with?", "Whole Number Finder", Type:=1)
    If StartingDivisor = 0 Then Exit Sub
'
    For DivisorIncrementer = StartingDivisor To Xvalue
        If Xvalue Mod DivisorIncrementer = 0 Then
            Range("G" & RowCounter) = DivisorIncrementer
            Range("H" & RowCounter) = Xvalue
            Range("I" & RowCounter) = Xvalue / DivisorIncrementer
            RowCounter = RowCounter + 1
        End If
    Next
    MsgBox "Done"
End Sub

 

[motilulla]

@motilulla Perhaps like this?

MRXLMAY21.xlsm
	G	H
2	Number	Value
3	1	2118770
4	2	2118770
5	5	2118770
6	10	2118770
7	211877	2118770
8	423754	2118770
9	1059385	2118770
10	2118770	2118770
Sheet6

Sub Factors()
Dim Num As Long
Dim F As Long
Dim r As Integer

On Error GoTo Out

Num = 1 * InputBox("Please enter a positive integer to be factorised.")
F = 1 * InputBox("Please enter a positive integer as first divisor.")
r = 3

Application.ScreenUpdating = False

Range("G:H").ClearContents
Range("G2") = "Number"
Range("H2") = "Value"

Do Until F > Num

If (Evaluate("MOD(" & Num & "," & F & ") = 0")) Then
Range("G3").Offset(OS, 0) = F
Range("G3").Offset(OS, 1) = Num
OS = OS + 1
End If

If F > Num Then Exit Do
F = F + 1
Loop

Out:
Application.ScreenUpdating = True
End Sub

It is taking something like 30 seconds per million iterations of the loop.
So the above example took 1min 5 sec.
Your original example takes 8 seconds.
It could no doubt be speeded up if using arrays.

Hope that helps.

Amezing! Snakehips, your VBA code is wow! I tested it with "positive integer to be factorised =5.000.000 & positive integer as first divisor =1 it just too 34 seconds.

It worked out of my imaginations thank you very much for your precious time you spent to solve it, as I wanted.

Good Luck!

Kind Regards,
Moti

 

[johnnyL]

Amezing! Snakehips, your VBA code is wow! I tested it with "positive integer to be factorised =5.000.000 & positive integer as first divisor =1 it just too 34 seconds.

It worked out of my imaginations thank you very much for your precious time you spent to solve it, as I wanted.

Good Luck!

Kind Regards,
Moti

Did you test my code with those numbers? Don't blink! lol

 

[motilulla]

Original numbers tested results in virtually instantaneous results with the following code:

Sub FindWholeNumbers()
'
    Dim DivisorIncrementer  As Long
    Dim RowCounter          As Long
    Dim StartingDivisor     As Long
    Dim Xvalue              As Long
'
    RowCounter = 3
'
    Xvalue = Application.InputBox("What is the X value?", "Whole Number Finder", Type:=1)
    If Xvalue = 0 Then Exit Sub
'
    StartingDivisor = Application.InputBox("What is the Divisor number to start with?", "Whole Number Finder", Type:=1)
    If StartingDivisor = 0 Then Exit Sub
'
    For DivisorIncrementer = StartingDivisor To Xvalue
        If Xvalue Mod DivisorIncrementer = 0 Then
            Range("G" & RowCounter) = DivisorIncrementer
            Range("H" & RowCounter) = Xvalue
            Range("I" & RowCounter) = Xvalue / DivisorIncrementer
            RowCounter = RowCounter + 1
        End If
    Next
    MsgBox "Done"
End Sub

Did you test my code with those numbers? Don't blink! lol

Wow johnnyL, Your VBA code is more sophisticated it took with X value = 5.000.000 & Divisor =1, only and only 6 seconds as well interesting showing all three field Number, Value and whole number also I will go with you code I am happy.

Thank you very much for your precious and solving it, more then, my expectations. ?

Good Luck!

Kind Regards,
Moti

 

[johnnyL]

6 seconds? That seems kind of long. Is that how long it took the messagebox to pop up, or does it include the time it took you to click ok on the message box? I would suggest that you comment out the messagebox line at the end of the code and retime it. 6 seconds is waaaaay too long.

 

[Fluff]

6 seconds is about right for the values the OP stated in post#6

 

[motilulla]

6 seconds? That seems kind of long. Is that how long it took the messagebox to pop up, or does it include the time it took you to click ok on the message box? I would suggest that you comment out the messagebox line at the end of the code and retime it. 6 seconds is waaaaay too long.

johnnyL, I am using following timer

'-----------------------------Timer----------------------------------------------------------
Dim dtStartTime As Date
dtStartTime = Now()
'-----------------------------Timer----------------------------------------------------------

Code.....

'-----------------------------Timer----------------------------------------------------------
MsgBox "Macro ran successfully in " & _
FormatDateTime(Now() - dtStartTime, 3), vbInformation
'-----------------------------Timer----------------------------------------------------------

This gave me following Msg..Macro ran successfully in 0:00:06 how do you read this is it not a 6 second?

Kind Regards,
Moti

 

[johnnyL]

You should not include the time it takes to enter the starting values.

The following runs the code 5 times in under a second.

Try the following:

Sub FindWholeNumbersTimed()
'
    Dim DivisorIncrementer  As Long
    Dim RowCounter          As Long
    Dim StartingDivisor     As Long
    Dim Xvalue              As Long
    Dim TimedTrials As Long
'
    RowCounter = 3
'
    Xvalue = Application.InputBox("What is the X value?", "Whole Number Finder", Type:=1)
    If Xvalue = 0 Then Exit Sub
'
    StartingDivisor = Application.InputBox("What is the Divisor number to start with?", "Whole Number Finder", Type:=1)
    If StartingDivisor = 0 Then Exit Sub
'
    Range("J2:N2").Delete Shift:=xlUp                                                                   ' Delete any previously timed values
'
    For TimedTrials = 1 To 5
        Start = Timer
'
        For DivisorIncrementer = StartingDivisor To Xvalue
            If Xvalue Mod DivisorIncrementer = 0 Then
                Range("G" & RowCounter) = DivisorIncrementer
                Range("H" & RowCounter) = Xvalue
                Range("I" & RowCounter) = Xvalue / DivisorIncrementer
                RowCounter = RowCounter + 1
            End If
        Next
        Cells(2, TimedTrials + 9) = Timer - Start
        TotalRunTime = TotalRunTime + Cells(2, TimedTrials + 9)
    Next
'
    Range("P2") = TotalRunTime / 5
'
    MsgBox "Done Calculating"
End Sub

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1										Time Trial 1	Time Trial 2	Time Trial 3	Time Trial 4	Time Trial 5		Average Time in seconds
2							Number	Value	Whole #	0.1953125	0.1484375	0.15234375	0.15234375	0.15625		0.1609375
3							1	5000000	5000000
4							2	5000000	2500000
5							4	5000000	1250000
6							5	5000000	1000000
7							8	5000000	625000
8							10	5000000	500000
9							16	5000000	312500
10							20	5000000	250000
11							25	5000000	200000
12							32	5000000	156250
13							40	5000000	125000
14							50	5000000	100000
15							64	5000000	78125
16							80	5000000	62500
17							100	5000000	50000
18							125	5000000	40000
19							160	5000000	31250
20							200	5000000	25000
21							250	5000000	20000
22							320	5000000	15625
23							400	5000000	12500
24							500	5000000	10000
25							625	5000000	8000
26							800	5000000	6250
27							1000	5000000	5000
28							1250	5000000	4000
29							1600	5000000	3125
30							2000	5000000	2500
31							2500	5000000	2000
32							3125	5000000	1600
33							4000	5000000	1250
34							5000	5000000	1000
35							6250	5000000	800
36							8000	5000000	625
37							10000	5000000	500
38							12500	5000000	400
39							15625	5000000	320
40							20000	5000000	250
41							25000	5000000	200
42							31250	5000000	160
43							40000	5000000	125
44							50000	5000000	100
45							62500	5000000	80
46							78125	5000000	64
47							100000	5000000	50
48							125000	5000000	40
49							156250	5000000	32
50							200000	5000000	25
51							250000	5000000	20
52							312500	5000000	16
53							500000	5000000	10
54							625000	5000000	8
55							1000000	5000000	5
56							1250000	5000000	4
57							2500000	5000000	2
58							5000000	5000000	1
Sheet1