VBA, Sorting based on custom list - excel

I am trying to sort my records based on Col A values, there are 5 different values and many rows (in a table). Also I have the custom list created in excels built in sort feature.
I am getting an error Sort method of range class failed on
oRangeSort.Sort Key1:=oRangeKey, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Here is my code:
Sub Sort()
Dim oWorksheet As Worksheet
Set oWorksheet = ActiveWorkbook.Worksheets("database")
Dim oRangeSort As Range
Dim oRangeKey As Range
' one range that includes all colums do sort
Set oRangeSort = oWorksheet.Range("A2:FR20000")
' start of column with keys to sort
Set oRangeKey = oWorksheet.Range("A2")
' custom sort order
Dim sCustomList(1 To 5) As String
sCustomList(1) = "sort1"
sCustomList(2) = "sort2"
sCustomList(3) = "sort3"
sCustomList(4) = "sort4"
sCustomList(5) = "sort5"
Application.AddCustomList ListArray:=sCustomList
oWorksheet.Sort.SortFields.Clear
oRangeSort.Sort Key1:=oRangeKey, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
' clean up
ActiveSheet.Sort.SortFields.Clear
Application.DeleteCustomList Application.CustomListCount
Set oWorksheet = Nothing
End Sub

Try a VBA sort as opposed to rewriting the recorded sort code.
Sub custom_sort()
Dim vCustom_Sort As Variant, rr As Long
vCustom_Sort = Array("sort1", "sort2", "sort3", "sort4", "sort5")
Application.AddCustomList ListArray:=vCustom_Sort
With ActiveWorkbook.Worksheets("database")
.Sort.SortFields.Clear
rr = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range("A2:FR" & rr)
.Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, DataOption1:=xlSortNormal, _
Orientation:=xlTopToBottom, Header:=xlYes, MatchCase:=False, _
OrderCustom:=Application.CustomListCount + 1
End With
.Sort.SortFields.Clear
End With
End Sub

Related

Sort columns by header name but if header name not present then sort by other header names

I have some person data that I need VBA to sort by header name, but sometimes one of the headers isn't there and I need it to skip the block of code and sort by different header names. Also, I could only figure out how to do three columns and not four so if someone can help me figure that out too that would be amazing!
I need it to sort ascending:
Grade, Teacher, Last Name, First Name
-OR-
Grade, Last Name, First Name
Dim Fnd(1 To 3) As Range
Dim Ary As Variant
Dim i As Long
Ary = Array("Grade", "Teacher", "Last Name")
For i = 1 To 3
Set Fnd(i) = Range("1:1").Find(Ary(i - 1), , , xlWhole, , , False, , False)
Next i
Range("A1").CurrentRegion.Sort _
key1:=Fnd(1), order1:=xlAscending, _
key2:=Fnd(2), order2:=xlAscending, _
key3:=Fnd(3), order3:=xlAscending, _
Header:=xlYes
Something like this should work:
Dim SortColumns As Variant
SortColumns = Array("Grade", "Teacher", "Last Name", "First Name") 'define all columns to sort by
With ThisWorkbook.Worksheets("Sheet1") 'specify your sheet here
.Sort.SortFields.Clear
Dim RngFound As Range
Dim SortColumn As Variant
For Each SortColumn In SortColumns
Set RngFound = Nothing
Set RngFound = .Range("1:1").Find(SortColumn, , , xlWhole, , , False, , False)
If Not RngFound Is Nothing Then ' add to sortfields if header was found
.Sort.SortFields.Add2 Key:=RngFound.EntireColumn, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End If
Next SortColumn
.Sort.SetRange .Range("A1").CurrentRegion
.Sort.Header = xlYes
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.SortMethod = xlPinYin
.Sort.Apply
End With
It will sort by all 4 fields if they exist and just ignore the ones that do not exist.
Range.Sort is limited to 3 keys at once, but you can sort multiple times and use different columns each time. You would put these in reverse order, because the final sort will override the previous sorts.
Here's how I would do it:
Sub HeaderSort()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim HeaderLabels As Variant
HeaderLabels = Array("Grade", "Teacher", "Last Name", "First Name")
Dim HCols() As Range, i As Long
ReDim HCols(LBound(HeaderLabels) To UBound(HeaderLabels))
For i = LBound(HeaderLabels) To UBound(HeaderLabels)
Set HCols(i) = ws.Rows(1).Find(HeaderLabels(i), , , xlWhole, , , False, , False)
Next i
If HCols(1) Is Nothing Then 'Teacher header not found
ws.Range("A1").CurrentRegion.Sort _
key1:=HCols(0), order1:=xlAscending, _
key2:=HCols(2), order2:=xlAscending, _
key3:=HCols(3), order3:=xlAscending, _
Header:=xlYes
Else 'All 4 headers found
'Sort the 4th, least priority header first
ws.Range("A1").CurrentRegion.Sort key1:=HCols(3), order1:=xlAscending, Header:=xlYes
'Sort the other three
ws.Range("A1").CurrentRegion.Sort _
key1:=HCols(0), order1:=xlAscending, _
key2:=HCols(1), order2:=xlAscending, _
key3:=HCols(2), order3:=xlAscending, _
Header:=xlYes
End If
End Sub

Want to augment code to paste only values, would like to change range to specific columns

Looking to augment my existing code to paste only values, and would like to change the copy range to select columns only.
Sub CopySort()
Dim dEnd As Integer
Sheets("Sorted").Range("A2:R250").ClearContents
Sheets("Portfolio").Select
Range("a1").Select
dEnd = Selection.End(xlDown).Row
Range("A5:" & "Z" & dEnd).Copy
Sheets("Sorted").Select
Range("A2").Select
ActiveSheet.Paste
Columns("A:R").Sort key1:=Range("A:A"), order1:=xlAscending, Header:=xlYes, _
key2:=Range("F:F"), order2:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Application.CutCopyMode = False
End Sub

Sort Method of Range class failed

I am new to VBA and having a hard time figuring out this code.I am doing a course online and i followed the same steps but somehow i'm getting an error.I recently installed Excel 2013 and dont know if thats the issue.I tried putting .Range("A4") but that gives me an error of "Invalid or Unqualified Reference"
Sub DivisionSort()
'
' Sort List by Division Ascending
'
'
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Sub CategorySort()
'
' Sort List by Category Ascending
'
'
Selection.Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Sub TotalSort()
'
' Sort List by Total Sales Ascending
'
'
Selection.Sort Key1:=Range("F4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Public Sub SortList()
Dim userinput As String
userinput = InputBox("1=Sort by Division, 2=Sort by Category,3=Sort by Total")
If userinput = "1" Then
DivisionSort
ElseIf userinput = "2" Then
CategorySort
ElseIf userinput = "3" Then
TotalSort
End If
End Sub
Try to avoid use of 'Selection'. Try instead a full reference:
ThisWorkbook.Sheets("Sheet1").Range("Table1").Sort

Sort key range query

Why does this work:
Range(Cells(1, 1), Cells(5, 5)).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
But this doesn't?:
Range(Cells(1, 1), Cells(5, 5)).Select
Selection.Sort Key1:=Range(Cells(1,1)), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Saying the
Method Range failed
EDIT
The reason for asking is that I would like the sort key to be dynamic, such as:
Selection.Sort Key1:=Range(Cells(intRow, intCol))
I can't see how this is done.
The Cells call is already returning a Range object, so you should use
Selection.Sort Key1:=Cells(1,1), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
I think that your confusion is stemming from the fact that passing two Cells parameters to Range is valid, i.e. Range(Cells(1, 1), Cells(5, 5)), but it is not valid to only pass one Cells parameter, i.e. Range(Cells(1, 1))
You can see this for yourself with the following snippet
Public Sub test()
Dim rng As Range
Set rng = Range(Cells(1, 1), Cells(3, 1))
MsgBox rng.Cells.Count
Set rng = Range(Cells(1, 1))
MsgBox rng.Cells.Count
End Sub
You will get a message saying 3 for the first msgbox call, but you get an exception when trying to set rng the second time.
As to why the second format is not valid, I have no idea. If you find out why the devs built it this way, let us know.
It's always best to qualify exactly which objects you are working with and work directly with the objects, as opposed to using Selection or just Range, as it can sometimes lead to unintended consequences or slow your code down.
Try this:
Dim ws as Worksheet
Set ws = Sheets("Sheet1") ' replace with your sheet name
'assume you wrap this around a loop to move through intRow and intCol _
or set them in some other fasion
With ws.Range(Cells(1,1), Cells(5,5)
.Sort Key1:=.Cells(intRow, intCol), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
The reason for asking is that I would like the sort key to be dynamic ...
At least part of the problem is relying on .Select and the subsequent Selection as the working area. If your intention is to work with the Range.CurrentRegion property (the 'island' of data origination in A1) then use a With ... End With statement to define the .CurrentRegion and work with it.
with worksheets("Sheet1") `<~~ set the parent worksheet!
with .Cells(1, 1).CURRRENTREGION `<~~ set the 'island' of data
.cells.Sort Key1:=.cells(1), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
end with
end with
I'm a little unclear on what you mean by 'dynamic'. The above will use the cell in the top-left of the area defined by .CurrentRegion. If you used With .Range("D5:H99") then .Cells(1) would refer to D5.
See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.

Application or object defined error. Run time error 1004

Cells.Sort Key1:=Range(rng1), Order1:=xlAscending, Key2:=Range(rng2) _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, DataOption2 _
:=xlSortNormal
It's throwing an error called application error or object defined error.
Try this sort operation coding alternative. It is pared down to only what you absolutely need.
dim rng1 as range, rng2 as range
With ActiveSheet '<-set this properly as With Sheets("Sheet1")
set rng1 = .Range("A1") 'Top cell of the primary sort key
set rng2 = .Range("B1") 'Top cell of the secondary sort key
With .Range("A1").CurrentRegion '<-sort the 'island' of data that surrounds A1 (with a header)
.Cells.Sort Key1:=rng1, Order1:=xlAscending, _
Key2:=rng2, Order2:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes
End With
End With

Resources