Create a custom range number list till max input

[motilulla]

Using Excel 2010
Hello,

Here below in the sheet I have shown 3 examples but need macro or formula which I want to create a custom range number list till max input….
Example1…D3 max range 890 friction 50 create range from 1 to 890 in range C6:E23

Example2…H3 max range 1249 friction 75 create range from 1 to 1249 in range G6:I22

Example2…L3 max range 930 friction 100 create range from 1 to 930 in range K6:M15

Note: I want a formula or a macro which can be used in Excel 2000 also.
Here is an example sheet with expected results…

Sort By Range.xls
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1
2				Max Range				Max Range				Max Range
3				890				1249				930
4				Friction 50				Friction 75				Friction 100
5
6			1	To	50		1	To	75		1	To	100
7			51	To	100		76	To	150		101	To	200
8			101	To	150		151	To	225		201	To	300
9			151	To	200		226	To	300		301	To	400
10			201	To	250		301	To	375		401	To	500
11			251	To	300		376	To	450		501	To	600
12			301	To	350		451	To	525		601	To	700
13			351	To	400		526	To	600		701	To	800
14			401	To	450		601	To	675		801	To	900
15			451	To	500		676	To	750		901	To	930
16			501	To	550		751	To	825
17			551	To	600		826	To	900
18			601	To	650		901	To	975
19			651	To	700		976	To	1.050
20			701	To	750		1.051	To	1.125
21			751	To	800		1.126	To	1.200
22			801	To	850		1.201	To	1.249
23			851	To	890
24
Sheet1

Regards,
Moti

 

[Ezguy4u]

That's what I love about this sight. I come up with a program that uses about 30 lines of code and an A+ student does the same thing with 10 lines of code. I am adding Peter's program to my toolbox.

 

[motilulla]

A little risky in my opinion as if there was no previous calculation they delete everything in that header area.
I would also recommend not using one of vba's standard words as a variable name (eg Count) as that can sometimes lead to disastrous results.


Here is another option with no Dim statements at all & no looping to create each row individually.
This also deletes any previous calculation but preserves the heading section if no prior calc.

Sub CreateCustomRange()
  Range("C1", Range("E" & Rows.Count).End(xlUp)).Offset(5).Clear
  With Range("C6:E6").Resize(Range("D3").Value / Range("E4").Value + 1)
    .Formula = Array("=C5+E$4", "To", "=min(E5+E$4,D$3)")
    .Cells(1).Value = 1
    .Value = .Value
    .Columns(2).HorizontalAlignment = xlCenter
    .Font.Bold = True
    If .Cells(.Rows.Count, 1).Value > Range("D3").Value Then .Rows(.Rows.Count).Clear
  End With
End Sub

Example:

motilulla.xlsm
	C	D	E
1
2		Max Range
3		48000000
4		Friction	13983816
5
6	1	To	13983816
7	13983817	To	27967632
8	27967633	To	41951448
9	41951449	To	48000000
10
Sheet4

Hello Peter_SSs, thank you for looking into #Post10 code and giving a best advice and making a shorter and safer macro it in not just shorter but quick also I guess it is because of no looping.

Peter_SSs, You are a star. I have adapted your code to work with it.

I sincerely appreciate your caring help. I wish you Good Luck!

Kind Regards,

Moti

 

[Peter_SSs]

You are welcome. Glad to contribute.