Need excel to sort first 7 values only)

[Eric Penfold]

Trying to use a loop to sort first 7 values only in A2 to last row with Range A2:H to last row?

Sub Number_Sort()

    Dim ws     As Worksheet
    Dim Lr     As Long
    Dim Rng    As Range
    Dim v      As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
    
    
    
    Set ws = ThisWorkbook.Worksheets("Frost Drains")
    Lr = ws.Cells(Rows.Count, 1).End(xlUp).Row - 1
    Set Rng = ws.Range("A2:H" & Lr)
    
    With ws
        For Each v In .Range("A2:A" & Lr)
            v.Offset(0, 1).Value = Val(Mid(v, Evaluate("=MIN(FIND({0,1,2,3,4,5,6,7}," & v.Address & "&""01234567""))")))
            .Range("A:H").Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes
            Rng.RemoveDuplicates Columns:=Array(1), Header:=xlYes
        Next v
    End With
i
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
    End With
    
End Sub

 

[Akuini]

Could you post an example (preferably by using XL2BB)? Create a mock up data, say 10 rows, and also show us what the result should look like.

 

[Eric Penfold]

Part No	Date	Issue	Drawn By	Design By	Description	Size	Material
33.0414	28/06/2023	1	DLS	Frost		182L 100d	Cast Iron & Aluminium
33.0433	27/06/2023	1	DLS	Frost		182L 100d	Cast Iron & Aluminium
33.0434	19/06/2023	1	DLS	Frost	Frost Grating adjustable 182mm Square threaded BSP4	182SQ 100d	Aluminium
31.0220.P	18/05/2023	1	DLS	Frost	Frost Floor drain 150mm square nickel bronze grating with large sump body and spigot outlet	150SQ 190d	Cast Iron + Nickel Bronze
31.0221.P	18/05/2023	1	DLS	Frost	Frost floor drain 150mm square nickel bronze grating with medium sump - 'P' trap - spigot outlet	198Ø 110d	Cast Iron + Stainless Steel
31.0221.SC	18/05/2023	1	DLS	Frost	Frost floor drain 150mm square nickel bronze grating with medium sump - 'S' trap - spigot outlet	198Ø 190d	Cast Iron + Stainless Steel
33.0411.9	28/06/2023	1	DLS	Frost			Cast Iron & Aluminium

 

[Eric Penfold]

As you can see above the 33.0411.9 Needs to be above 33.0414. Sorry can`t get XL2BB to work at the moment.

 

[Eric Penfold]

Please can you help me

 

[Akuini]

I don't understand, when I sort the data manually here's the result:

Book2
	A	B	C	D	E	F	G	H
1	Part No	Date	Issue	Drawn By	Design By	Description	Size	Material
2	31.0220.P	18/05/2023	1	DLS	Frost	Frost Floor drain 150mm square nickel bronze grating with large sump body and spigot outlet	150SQ 190d	Cast Iron + Nickel Bronze
3	31.0221.P	18/05/2023	1	DLS	Frost	Frost floor drain 150mm square nickel bronze grating with medium sump - 'P' trap - spigot outlet	198Ø 110d	Cast Iron + Stainless Steel
4	31.0221.SC	18/05/2023	1	DLS	Frost	Frost floor drain 150mm square nickel bronze grating with medium sump - 'S' trap - spigot outlet	198Ø 190d	Cast Iron + Stainless Steel
5	33.0411.9	28/06/2023	1	DLS	Frost			Cast Iron & Aluminium
6	33.0414	28/06/2023	1	DLS	Frost		182L 100d	Cast Iron & Aluminium
7	33.0433	27/06/2023	1	DLS	Frost		182L 100d	Cast Iron & Aluminium
8	33.0434	19/06/2023	1	DLS	Frost	Frost Grating adjustable 182mm Square threaded BSP4	182SQ 100d	Aluminium
Sheet5

which part of the result does not meet your criteria?

 

[Eric Penfold]

When sort manually it works but i need to use VBA for this.
So that`s where i have got first seven values in my code then how can i use just those values to sort data?

 

[Akuini]

Sample in post #3, the values in A2:A4, are they number or text?

 

[Eric Penfold]

Numbers
Any cells with letters i need to ignore any letters just use the numbers to sort.

 

[Akuini]

Numbers
Any cells with letters i need to ignored any letters just use the numbers to sort.

Having text & number data type in the same column will make it harder to deal wtih.
This code will change the number to text by adding apostrophe in front of it and then sort the data.

Sub try()
Dim c As Range
Set ws = ActiveSheet
    Lr = ws.Cells(Rows.Count, 1).End(xlUp).Row - 1
    Set Rng = ws.Range("A1:A" & Lr)

    For Each c In Rng
        If IsNumeric(c) Then
            c.Value = "'" & c.Formula
        End If
    Next
  
    With ws.Range("A:A")
        .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
    End With
End Sub