Extract Odds from the range

[motilulla]

Using Excel 2010
Hello,

I have a 5 number in columns D:H I want a formula or a macro which can Extract odd numbers from 1 To 25 in Columns J:N and Extract odd numbers from 26 To 50 in Columns P:T

Note: I want a formula or a macro which can be used in Excel 2000 also.

Here is a example sheet with expected results…

Odds.xls
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1
2
3
4				n1	n2	n3	n4	n5	EM	Odd 1 To 25					EM	Odd 26 To 50
5				n1	n2	n3	n4	n5	EM	n1	n2	n3	n4	n5	EM	n1	n2	n3	n4	n5
6				16	29	32	36	41								29	41
7				7	13	39	47	50		7	13					39	47
8				14	18	19	31	37		19						31	37
9				4	7	33	37	39		7						33	37	39
10				15	24	28	44	47		15						47
11				33	36	37	42	45								33	37	45
12				3	4	10	23	43		3	23					43
13				27	31	35	47	49								27	31	35	47	49
14				1	4	10	19	23		1	19	23
15				14	15	28	35	40		15						35
16				6	10	21	45	49		21						45	49
17				5	6	16	23	27		5	23					27
18				15	16	21	36	38		15	21
19				1	3	21	32	39		1	3	21
20				15	29	37	39	49		15						29	37	39	49
21				1	7	9	17	23		1	7	9	17	23
22
Sheet1

Regards,
Moti

 

[mumps]

Place this formula in J6 and then copy it across to N6. Next select J6:N6 and copy down to row 21:
=IF(AND(MOD(D6,2)=1,AND(D6>=1,D6<=25)),D6,"")

Place this formula in P6 and then copy it across to T6. Next select P6:T6 and copy down to row 21:
=IF(AND(MOD(D6,2)=1,AND(D6>=26,D6<=50)),D6,"")

 

[motilulla]

Hello mumps, yes your formula worked for both the version fine, does it is possible to get result as #post1 combined without spacing.

I appreciate your kind help.

Odds.xls
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1
2
3
4				n1	n2	n3	n4	n5	EM	Odd 1 To 25					EM	Odd 26 To 50
5				n1	n2	n3	n4	n5	EM	n1	n2	n3	n4	n5	EM	n1	n2	n3	n4	n5
6				16	29	32	36	41									29			41
7				7	13	39	47	50		7	13							39	47
8				14	18	19	31	37				19							31	37
9				4	7	33	37	39			7							33	37	39
10				15	24	28	44	47		15										47
11				33	36	37	42	45								33		37		45
12				3	4	10	23	43		3			23							43
13				27	31	35	47	49								27	31	35	47	49
14				1	4	10	19	23		1			19	23
15				14	15	28	35	40			15								35
16				6	10	21	45	49				21							45	49
17				5	6	16	23	27		5			23							27
18				15	16	21	36	38		15		21
19				1	3	21	32	39		1	3	21								39
20				15	29	37	39	49		15							29	37	39	49
21				1	7	9	17	23		1	7	9	17	23
22
Sheet1

Cell Formulas
Range	Formula
J6:N21	J6	=IF(AND(MOD(D6,2)=1,AND(D6>=1,D6<=25)),D6,"")
P6:T21	P6	=IF(AND(MOD(D6,2)=1,AND(D6>=26,D6<=50)),D6,"")

Good Luck

Kind Regards,

Moti

 

[mumps]

I don't think that I can do that with a formula. I would probably need a macro.

 

[motilulla]

I don't think that I can do that with a formula. I would probably need a macro.

Hello mumps, thank you for the replay if so can you build a macro that will be great.

I appreciate your kind help.

Good Luck

Kind Regards,

Moti

 

[mumps]

Try:

Sub ExtractOdds()
    Application.ScreenUpdating = False
    Dim v As Variant, r As Long, c As Long, x As Long, y As Long
    x = 10: y = 16
    v = Range("D6", Range("D" & Rows.Count).End(xlUp)).Resize(, 5).Value
    For r = LBound(v) To UBound(v, 1)
        For c = LBound(v) To UBound(v, 2)
            If v(r, c) Mod 2 = 1 And v(r, c) >= 1 And v(r, c) <= 25 Then
                Cells(r + 5, x) = v(r, c)
                x = x + 1
            ElseIf v(r, c) Mod 2 = 1 And v(r, c) >= 26 And v(r, c) <= 50 Then
                Cells(r + 5, y) = v(r, c)
                y = y + 1
            End If
        Next c
        x = 10: y = 16
    Next r
    Application.ScreenUpdating = True
End Sub

 

[motilulla]

Try:

Sub ExtractOdds()
    Application.ScreenUpdating = False
    Dim v As Variant, r As Long, c As Long, x As Long, y As Long
    x = 10: y = 16
    v = Range("D6", Range("D" & Rows.Count).End(xlUp)).Resize(, 5).Value
    For r = LBound(v) To UBound(v, 1)
        For c = LBound(v) To UBound(v, 2)
            If v(r, c) Mod 2 = 1 And v(r, c) >= 1 And v(r, c) <= 25 Then
                Cells(r + 5, x) = v(r, c)
                x = x + 1
            ElseIf v(r, c) Mod 2 = 1 And v(r, c) >= 26 And v(r, c) <= 50 Then
                Cells(r + 5, y) = v(r, c)
                y = y + 1
            End If
        Next c
        x = 10: y = 16
    Next r
    Application.ScreenUpdating = True
End Sub

Wow mumps, macro worked fantastic and got the expected result as requested. Thank you so much for your kind help and time you spent for giving a perfect solution for my query.

Good Luck!

Kind Regards,
Moti

 

[mumps]

You are very welcome.