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

 

[Eric Penfold]

Akuini,

Seems to work after slight adjustment to the code see below. Once but soon as i try the next number on the list it stops working.

Sub Number_Sort()

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

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
    
    Set ws = ActiveSheet
    Lr = ws.Cells(Rows.Count, 1).End(xlUp).Row - 1
    Set Rng = ws.Range("A1:A" & Lr)
    
    For Each v In Rng
        If IsNumeric(v) Then
            v.Value = "'" & v.Formula
        End If
    Next
    
    With ws
        Range("A2:H" & Lr).Sort , _
                      Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
    End With
    
End Sub

 

[Akuini]

Let's try referencing the sheet properly.

Sub try2()
Dim c As Range
Dim Ws As Worksheet
Dim LR As Long
Set Ws = ThisWorkbook.Worksheets("Frost Drains")
    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("A1:H" & LR)
        .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
    End With
End Sub

 

[Eric Penfold]

I tried to convert values back to numbers for next time you run the code which works.
Just not sure why the code above won`t recognize number format the next time you need to add a number??

Public Sub Text_to_Number()

    Dim Ws     As Worksheet
    Dim Rng    As Range
    Dim v      As Range
    Dim LR     As Long
    Dim N As Variant

    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:A" & LR)
    
    With Ws
    For Each N In Rng
        If IsNumeric(N) Then
            N.Value = CSng(N.Value)
            N.NumberFormat = "0.0000"
        End If
    Next
    End With
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
    End With
    
End Sub

 

[Eric Penfold]

It`s now working see code alteration below.

Sub Number_Sort()

    Dim c      As Range
    Dim Ws     As Worksheet
    Dim LR     As Long
    Dim Rng    As Range

    Set Ws = ThisWorkbook.Worksheets("Frost Drains")
    LR = Ws.Cells(Rows.Count, 1).End(xlUp).Row - 1
    Set Rng = Ws.Range("A1:A" & LR)
    
    For Each c In Rng
        If Application.WorksheetFunction.IsNumber(c.Value) = True Then
            c.Value = "'" & c.Formula
        End If
    Next
    
    With Ws.Range("A1:H" & LR + 1)
        .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
    End With
    
    Call Text_to_Number
    
End Sub

 

[Akuini]

1. I forgot, the code in post #22 (and also all before that) this part:

LR = Ws.Cells(Rows.Count, 1).End(xlUp).Row - 1

should be

LR = Ws.Cells(Rows.Count, 1).End(xlUp).Row

2. This part of your code:

If Application.WorksheetFunction.IsNumber(c.Value) = True Then

Interesting, I don't know why changing the earlier code with this makes any differences. But glad it works now.