# Thread: Extract and arrange the numbers small to larger values Thanks:  5 Post #5359556 (2)Post #5359557 (1)Post #5359550 (1)Post #5359553 (1) Likes:  4 Post #5359553 (1)Post #5359556 (1)Post #5359557 (1)Post #5359550 (1)

1. ## Re: Extract and arrange the numbers small to larger values Originally Posted by DanteAmor Try this, This should write from P to Y without altering other columns.

Code:
```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

Kind Regards,
Moti   Reply With Quote

2. ## Re: Extract and arrange the numbers small to larger values

Another option
Code:
```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```  Reply With Quote

3. ## Re: Extract and arrange the numbers small to larger values Originally Posted by motilulla 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.   Reply With Quote

4. ## Re: Extract and arrange the numbers small to larger values Originally Posted by mohadin HI
Code:
```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```
Code:
`For i = 4 To Cells(Rows.Count, 5).End(xlUp).Row`

Kind Regards,
Moti   Reply With Quote

5. ## Re: Extract and arrange the numbers small to larger values Originally Posted by Fluff Another option
Code:
```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   Reply With Quote

6. ## Re: Extract and arrange the numbers small to larger values

My pleasure & thanks for the feedback  Reply With Quote

7. ## Re: Extract and arrange the numbers small to larger values

Hi Moti
Thank you for the feed back
Be Happy  Reply With Quote

## User Tag List

arrange, extract, larger, numbers, small 