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>

 

[igold]

How about this:

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

 

[DanteAmor]

Just another way to do it.

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

 

[motilulla]

How about this:

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 </SPAN></SPAN>

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

 

[motilulla]

Just another way to do it.

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</SPAN></SPAN>

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

 

[igold]

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

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 [COLOR=#ff0000]Range("L4")[/COLOR]
    Set rng2 = [COLOR=#ff0000]Range("L4:U"[/COLOR] & 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

 

[Rick Rothstein]

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...

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

 

[DanteAmor]

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.

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

 

[motilulla]

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...</SPAN></SPAN>

Book1
	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ
1
2
3	n1	n2	n3	n4	n5	n6	n7	n8	n9	n10		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										15	20	23	27	40	3	22	25	30	49
5	0	0	0	9	0	0	10	0	12	13		9	10	12	13								13	22	33	44	50	1	12	27	42	47
6	0	0	0	0	0	9	10	0	12	0		9	10	12									12	13	29	36	38	22	37	43	44	45
7	0	0	0	0	0	0	10	0	0	13		10	13										2	14	35	41	42	8	21	25	38	50
8	0	0	0	0	0	9	0	11	12	0		9	11	12									13	29	31	33	40	2	33	42	47	48
9	0	0	0	0	0	9	0	11	0	13		9	11	13									9	10	27	37	42	24	37	41	43	46
10	0	3	4	0	0	9	10	0	0	0		3	4	9	10								20	22	23	24	37	2	11	18	40	46
11	1	2	3	4	5	0	0	0	9	0		1	2	3	4	5	9						4	17	35	42	45	6	9	35	41	44
Sheet1

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

 

[mohadin]

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