Extract and arrange the numbers small to larger values

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,353
Office Version
  1. 2010
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
EFGHIJKLMNOPQRSTUVWXY
1
2
3n1n2n3n4n5n6n7n8n9n10n1n2n3n4n5n6n7n8n9n10
40000000110131113
500090010012139101213
600000910012091011
70000001000131013
800000901112091112
900000901101391113
100340091000034910
111234500090123459
Sheet1


Thank you all
</SPAN></SPAN>

Excel 2000
</SPAN></SPAN>
Regards,
</SPAN></SPAN>
Moti
</SPAN></SPAN>
 
Last edited:

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
How about this:

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
 
Last edited:
Upvote 0
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
 
Upvote 0
How about this:

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

Kind Regards,
</SPAN></SPAN>
Moti
</SPAN></SPAN>
 
Upvote 0
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</SPAN></SPAN>

Kind Regards,
</SPAN></SPAN>
Moti
</SPAN></SPAN>
 
Upvote 0
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 [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
 
Last edited:
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
EFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJ
1
2
3n1n2n3n4n5n6n7n8n9n10n1n2n3n4n5n6n7n8n9n10n1n2n3n4n5n6n7n8n9n10
400000001101311131520232740322253049
5000900100121391012131322334450112274247
60000091001209101212132936382237434445
70000001000131013214354142821253850
8000009011120911121329313340233424748
9000009011013911139102737422437414346
1003400910000349102022232437211184046
11123450009012345941735424569354144
Sheet1


Kind Regards, </SPAN></SPAN>
Moti </SPAN></SPAN>
 
Last edited:
Upvote 0
HI
What about
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
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,520
Messages
6,114,101
Members
448,548
Latest member
harryls

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top