# 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 #5359550 (1)Post #5359553 (1)Post #5359556 (1)Post #5359557 (1)

1. ## Extract and arrange the numbers small to larger values

Hello,

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

Example

EFGHIJKLMNOPQRSTUVWXY
1
2
3n1n2n3n4n5n6n7n8n9n10n1n2n3n4n5n6n7n8n9n10
40000000110131113
500090010012139101213
600000910012091011
70000001000131013
800000901112091112
900000901101391113
100340091000034910
111234500090123459

Sheet1

Thank you all

Excel 2000

Regards,

Moti  Reply With Quote

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

Code:
```Sub RemZero()

Dim rng1 As Range, rng2 As Range, r As Long

Application.ScreenUpdating = False
Set rng1 = Range("A4:J" & Cells(Rows.Count, 1).End(xlUp).Row)
rng1.Copy Range("L4")
Set rng2 = Range("L4:U" & Cells(Rows.Count, 1).End(xlUp).Row)
For r = rng2.Cells.Count To 1 Step -1
If rng2.Cells(r) = 0 Then rng2.Cells(r).Delete Shift:=xlToLeft
Next
Application.ScreenUpdating = True

End Sub```  Reply With Quote

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

Just another way to do it.

Code:
```Sub arrange_numbers1()
Dim c As Range
For Each c In Range("E4:N" & Range("E" & Rows.Count).End(xlUp).Row)
If c <> 0 Then Cells(c.Row, Cells(c.Row, Columns.Count).End(xlToLeft).Column + 1) = c
Next
Range("O4:O" & Range("E" & Rows.Count).End(xlUp).Row).Insert Shift:=xlToRight
End Sub```  Reply With Quote

4. ## Re: Extract and arrange the numbers small to larger values Originally Posted by igold Code:
```Sub RemZero()

Dim rng1 As Range, rng2 As Range, r As Long

Application.ScreenUpdating = False
Set rng1 = Range("A4:J" & Cells(Rows.Count, 1).End(xlUp).Row)
rng1.Copy Range("L4")
Set rng2 = Range("L4:U" & Cells(Rows.Count, 1).End(xlUp).Row)
For r = rng2.Cells.Count To 1 Step -1
If rng2.Cells(r) = 0 Then rng2.Cells(r).Delete Shift:=xlToLeft
Next
Application.ScreenUpdating = True

End Sub```
igold, thank you for the code you provide it works I need to shift the data in the blank sheet and run the code, if I run in the same sheet it disturb all the right columns data I got all the time columns E:N data update every day so is it possible the code work in the same sheet and update columns P:Y

Kind Regards,

Moti  Reply With Quote

5. ## Re: Extract and arrange the numbers small to larger values Originally Posted by DanteAmor Just another way to do it.

Code:
```Sub arrange_numbers1()
Dim c As Range
For Each c In Range("E4:N" & Range("E" & Rows.Count).End(xlUp).Row)
If c <> 0 Then Cells(c.Row, Cells(c.Row, Columns.Count).End(xlToLeft).Column + 1) = c
Next
Range("O4:O" & Range("E" & Rows.Count).End(xlUp).Row).Insert Shift:=xlToRight
End Sub```
DanteAmor, thank you for the code it is printing the results end of the used columns I need the result must be in P:Y columns without disturbing other columns data

Kind Regards,

Moti  Reply With Quote

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

Change the highlighted lines to where you want the results returned...

Code:
```Sub RemZero()

Dim rng1 As Range, rng2 As Range, r As Long

Application.ScreenUpdating = False
Set rng1 = Range("A4:J" & Cells(Rows.Count, 1).End(xlUp).Row)
rng1.Copy Range("L4")
Set rng2 = Range("L4:U" & Cells(Rows.Count, 1).End(xlUp).Row)
For r = rng2.Cells.Count To 1 Step -1
If rng2.Cells(r) = 0 Then rng2.Cells(r).Delete Shift:=xlToLeft
Next
Application.ScreenUpdating = True

End Sub```  Reply With Quote

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

Am I remembering correctly from past postings of yours... except for the zero values, aren't your numbers in each row of Columns E:N always in sorted numerical order from left to right? If so, this should work for you...
Code:
```Sub DumpZeros()
Range("E3").CurrentRegion.Copy Range("P3")
With Range("P3").CurrentRegion
.Replace 0, "", xlWhole, , , , False, False
.SpecialCells(xlBlanks).Delete xlShiftToLeft
End With
End Sub```  Reply With Quote

8. ## Re: Extract and arrange the numbers small to larger values Originally Posted by motilulla DanteAmor, thank you for the code it is printing the results end of the used columns I need the result must be in P:Y columns without disturbing other columns data

Kind Regards,

Moti

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```  Reply With Quote

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

Rick, code also is giving problem having data in the right columns, to be specific here is how my data looks I want result in columns P:Y without disturbing any data of the columns AA:AJ...

1
2
3n1n2n3n4n5n6n7n8n9n10n1n2n3n4n5n6n7n8n9n10n1n2n3n4n5n6n7n8n9n10
400000001101311131520232740322253049
5000900100121391012131322334450112274247
60000091001209101212132936382237434445
70000001000131013214354142821253850
8000009011120911121329313340233424748
9000009011013911139102737422437414346
1003400910000349102022232437211184046
11123450009012345941735424569354144

Sheet1

Kind Regards,
Moti  Reply With Quote

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

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```  Reply With Quote

## User Tag List

arrange, extract, larger, numbers, small 