Optimise code and include a variable.

[imcfcl]

Afternoon All,

Hope all is well - I've got some code that I've made with macro recorder (still not comfortable enough to write my own) but it isn't fit for use. It clearly needs a variable but I dont know how.

    Range("F17").Select
    Selection.Copy
    Range("D17").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("D17:D114")
    Range("D17:D114").Select
    Range("C17:D17").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Home").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Home").Sort.SortFields.Add Key:=Range("D17:D114") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Home").Sort
        .SetRange Range("C17:D114")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
End Sub

In col C, starting at C17, I have a list such with entries like 'Door 12' 'Door 45' 'Door 198' 'Door 1' and I need to sort this data smallest to biggest - obviously excel can't sort this type of list properly - So I've written this formula to trim the numbers off so that It can

=IF(LEN($C17)=6,RIGHT($C17,1),IF(LEN($C17)=7,RIGHT($C17,2),RIGHT($C17,3))) and it works and I've stored it in Cell F17.

I want to paste this formula next to every entry in my list, and then sort by column D. My list could go from C17 to C100, or it could go from C17 to D999 ... it will keep growing and thats why I can't use my recorded macro.

Help appreciated - and a pint for anyone who ever visits a little county called Cheshire.

 

[Andrew Poulsom]

Try the untested:

Sub Test()
    Dim LastRow As Long
    LastRow = Range("C" & Rows.Count).End(xlUp).Row
    Range("F17").Copy Range("D17")
    Application.CutCopyMode = False
    Range("D17").AutoFill Destination:=Range("D17:D" & LastRow)
    ActiveWorkbook.Worksheets("Home").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Home").Sort.SortFields.Add Key:=Range("D17:D" & LastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Home").Sort
        .SetRange Range("C17:D" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

I removed the unnecessary Selects.

 

[imcfcl]

Thanks for your time, it worked perfectly.

Cheers