Extract and arrange the numbers small to larger values

[motilulla]

Hello,</SPAN></SPAN>

I need to extract the numbers of column E:N and need to arrange them in order small to larger values in the columns P:Y</SPAN></SPAN>

Example

Book1
	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y
1
2
3	n1	n2	n3	n4	n5	n6	n7	n8	n9	n10		n1	n2	n3	n4	n5	n6	n7	n8	n9	n10
4	0	0	0	0	0	0	0	11	0	13		11	13
5	0	0	0	9	0	0	10	0	12	13		9	10	12	13
6	0	0	0	0	0	9	10	0	12	0		9	10	11
7	0	0	0	0	0	0	10	0	0	13		10	13
8	0	0	0	0	0	9	0	11	12	0		9	11	12
9	0	0	0	0	0	9	0	11	0	13		9	11	13
10	0	3	4	0	0	9	10	0	0	0		3	4	9	10
11	1	2	3	4	5	0	0	0	9	0		1	2	3	4	5	9
Sheet1

Thank you all </SPAN></SPAN>

Excel 2000</SPAN></SPAN>
Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>

 

[motilulla]

Try this, This should write from P to Y without altering other columns.

Sub arrange_numbers1()
  Dim c As Range, j As Long
  For Each c In Range("E4:N" & Range("E" & Rows.Count).End(xlUp).Row)
    If c.Column = 5 Then j = Columns("P").Column
    If c <> 0 Then
      Cells(c.Row, j) = c
      j = j + 1
    End If
  Next
End Sub

DanteAmor, yes this is spot on running perfect, thank you for your help</SPAN></SPAN>

Kind Regards, </SPAN></SPAN>
Moti </SPAN></SPAN>

 

[Fluff]

Another option

Sub Motilulla()
    Dim Ary As Variant, Nary As Variant
    Dim r As Long, c As Long, nc As Long
    
    Ary = Range("E4", Range("N" & Rows.Count).End(xlUp)).Value2
    ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
    For r = 1 To UBound(Ary)
        For c = 1 To UBound(Ary, 2)
            If Ary(r, c) > 0 Then
                nc = nc + 1
                Nary(r, nc) = Ary(r, c)
            End If
        Next c
        nc = 0
    Next r
    Range("P4").Resize(UBound(Nary), 10).Value = Nary
End Sub

 

[DanteAmor]

DanteAmor, yes this is spot on running perfect, thank you for your help

Kind Regards,
Moti

I'm glad to help you. Thanks for the feedback.

 

[motilulla]

HI
What about

Sub test()
    Dim b As Variant
    Dim lr, i
       For i = 5 To Cells(Rows.Count, 5).End(xlUp).Row
        ReDim b(1 To 10)
        t = 1
        For j = 5 To 15
            If Cells(i, j) <> 0 Then
                b(t) = Cells(i, j): t = t + 1
            End If
        Next
        Cells(i, 16).Resize(, UBound(b)) = b
    Next
End Sub

mohadin, yes your code also worked fine,just changed 5 to 4, thank you for your help

For i = [COLOR=#ff0000]4[/COLOR] To Cells(Rows.Count, 5).End(xlUp).Row

Kind Regards,
Moti

 

[motilulla]

Another option

Sub Motilulla()
    Dim Ary As Variant, Nary As Variant
    Dim r As Long, c As Long, nc As Long
    
    Ary = Range("E4", Range("N" & Rows.Count).End(xlUp)).Value2
    ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
    For r = 1 To UBound(Ary)
        For c = 1 To UBound(Ary, 2)
            If Ary(r, c) > 0 Then
                nc = nc + 1
                Nary(r, nc) = Ary(r, c)
            End If
        Next c
        nc = 0
    Next r
    Range("P4").Resize(UBound(Nary), 10).Value = Nary
End Sub

Fluff, Thank you for the help, yes your code also gave a required result Ok.

Kind Regards,
Moti

 

[Fluff]

My pleasure & thanks for the feedback

 

[mohadin]

Hi Moti
Thank you for the feed back
Be Happy