excel vba sort error 1004 - excel

i'm using this code for sorting (checked for Excel 2010/2013):
Worksheets("Tabelle4(1)").Activate
ActiveSheet.Sort.SortFields.Add Key:=Range( _
"W2:W51"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
I loop over a sheet 70 times with different values and sort and export them as a pdf.
Everything works fine, but after approximately 30 times I get an error 1004.
If I start the loop at this point 30 again it works fine.
The problem doesn't seem to do with the values.
Is there a buffer inside of excel, which I've to clear from time to time?

You should clear your Sort fields from time to time indeed, because they just accumulate and it'll be harder for you to prioritize them.
And just don't use Activate , nor Select which is even worse, so just combine Sheets().Activate and ActiveSheet.Sort to Sheets().Sort , your code will be much more efficient.
This should help you :
With Worksheets("Tabelle4(1)")
.Sort.SortFields.Add _
Key:=Range("W2:W51"), _
SortOn:=xlSortOnValues, _
Order:=xlDescending, _
DataOption:=xlSortNormal
.Sort.Orientation = xlTopToBottom
.Sort.Apply
'here is your export
.Sort.SortFields.Clear
End With

Set ws = Worksheets("Sheet1")
Set rng = ws.Range(Cells(startRow, 1), Cells(endRow, 3))
'startRow=2, endRow=18
'Sort Table Date Decending Order
ws.Sort.SortFields.Clear
With ws
.Sort.SortFields.Add Key:=rng, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.Orientation = xlTopToBottom
.Sort.SortMethod = xlPinYin
.Sort.Apply
End With
'This works but does not sort the data descending.

Related

Auto Filter sort in VBA for complicated case

Sorry for my English, I try my best.
I have the similar question as by link, and the top answer is perfect and works in cases we have up to three columns to sort by.
But the number of multiple columns I have to sort by is four and the code like this:
Sub try_1()
rng_range.Sort _
Key1:=Range("A1"), _
Order1:=xlAscending, _
Key2:=Range("B1"), _
Order2:=xlAscending, _
Key3:=Range("D1"), _
Order3:=xlAscending, _
Key4:=Range("C1"), _
Order4:=xlAscending, _
Header:=xlYes
End Sub
falls with error: "Run-time error '1004':
Application-defined or object-defined error"
The second difficulty is that one of my multiple columns consists of numbers saved as text and it's not a very good idea to convert text to numbers first and then to sort because of two reasons. First, there is too many rows (approximately 1kk). Second, these are 16-digit numbers, some of which begins with zeroes that I'm not supposed to lose.
Then I just record the macro and become the following code:
Sub try_2()
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort. _
SortFields.Add Key:=Range("A2:A1000000"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort. _
SortFields.Add Key:=Range("B2:B1000000"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort. _
SortFields.Add Key:=Range("D2:D1000000"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortTextAsNumbers
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort. _
SortFields.Add Key:=Range("C2:C1000000"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter. _
Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
The most important part of this code is:
DataOption:=xlSortTextAsNumbers
But my table is not constant, I sometimes add columns in between others so I want to replace all Sheet- and Range-objects by variables that I can receive by using Find method.
Before
Sub try_3()
sht_waiting_list.AutoFilter.Sort.SortFields.Clear
I declare
Public Const con_str_column_name_2_1 As String = "Key1 column"
Public Const con_str_column_name_2_2 As String = "Key2 column"
Public Const con_str_column_name_2_3 As String = "Key3 column"
Public Const con_str_column_name_2_4 As String = "Key4 column"
and instead of
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort. _
SortFields.Add Key:=Range("A2:A1000000"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
I have
sht_waiting_list.AutoFilter.Sort. _
SortFields.Add Key:=sht_waiting_list.Rows("1:1").Find(What:=con_str_column_name_2_1, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(1).Resize(rng_waiting_list.Rows.Count - 1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
This code has two more differences from recorded one:
With sht_waiting_list.Sort
.SetRange rng_waiting_list
There isn't the .AutoFilter method before .Sort method.
I've added one line to set the range i want to sort.
The fact is that
With sht_waiting_list.AutoFilter.Sort
.SetRange rng_waiting_list
(with the .AutoFilter method) doesn't work ("Run-time error '1004': Application-defined or object-defined error").
And, I completely don't understand how the sort-Range is set in case of Macro Recorder.
In this question I had to trim my code very hard. If you want to see the full version, read the history of edit versions.
Any suggestions?

Why do blank lines appear after multi-level sorting?

I have a macro that sorts by color, then by date, then again by date.
If I delete a date, instead of just re-sorting, it re sorts and then leaves blank rows where the row from which a date was deleted used to be. I tried adding another sort layer where I sort by color RGB(0,0,0).
Why are the blank rows sitting there?
How do I remove them or make them not appear at all?
If Not Intersect(Target, Range("A:C")) Is Nothing Then
MsgBox ("sorting")
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add(Range("C:C"), _
xlSortOnCellColor, _
xlDescending, _
, _
xlSortNormal).SortOnValue.Color = RGB(146, 208, 80)
ActiveSheet.Sort.SortFields.Add2 Key:=Range("C:C"), _
SortOn:=xlSortOnValues, _
Order:=xlDescending, _
DataOption:=xlSortNormal
ActiveSheet.Sort.SortFields.Add2 Key:=Range("B:B"), _
SortOn:=xlSortOnValues, _
Order:=xlDescending, _
DataOption:=xlSortNormal
ActiveSheet.Sort.SortFields.Add2(Range("C:C"), _
xlSortOnCellColor, _
xlDescending, _
, _
xlSortNormal).SortOnValue.Color = RGB(255, 255, 255)
With ActiveSheet.Sort
.SetRange Range("A:C")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
I believe I might have an answers to your questions, atleast for the second one I am sure...
Why are the blank rows sitting there?
I can be only guessing since I do not have your source file to check for any irregularities nor your whole macro. If I had to guess, I would say it is either some function in your macro what is causing this or it might also be an issue of how you define sort ranges. You only specify columns and not actual starting cells and also no ending cells. The way I am used to sort data is to dynamically define the exact range.
How do I remove them or make them not appear at all?
Please try the code which I have adjusted based on your data and code you provided:
If Not Intersect(Target, Range("A:C")) Is Nothing Then
MsgBox ("sorting")
With ActiveWorkbook.ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row '<-- get last row of data in column "A"
.Sort.SortFields.Clear
.Sort.SortFields.Add(Range("C1:C" & lastRow), _
xlSortOnCellColor, xlDescending, , xlSortNormal).SortOnValue.Color = RGB(146, 208, 80)
.Sort.SortFields.Add Key:=.Range("B1:B" & lastRow), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Range("C1:C" & lastRow), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SortFields.Add(Range("C1:C" & lastRow), _
SortOn:=xlSortOnCellColor, Order:=xlDescending, DataOption:=xlSortNormal).SortOnValue.Color = RGB(255, 255, 255)
With .Sort
.SetRange Range("A1:C" & lastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End If
The main adjustment is declaration of lastRow which adjusts the bottom of the data range (in your situation it should not matter but you might sometimes encounter data where you want to sort until certain row and this will be very helpful. Also lastRow as defined here is very helpful for a whole lot of other macros and helps to set ranges dynamically).
And I have also added the start the data as you can see in Range("C1:C" & lastRow)
I have tested this on a sample data you have provided and it worked as expected. I hope it will work for you exactly as you wanted to.

VBA Find NAMED column and filter - Nearly working macro

I am struggling to cover everything I need to do in one macro - I asked a similar question here a few hours ago and was answered however unfortunately I needed to add a few functions to my macro so I had to modify it slightly and now I require a tiny tweak that I can't get to work
Sub BoBTEST()
Dim c As Range
For Each c In Range("A1:BR1").Cells
If c.Value = "Plate Name (barcode)" Or c.Value = "Measurement Date" Or c.Value = "Measurement profile" Or c.Value = "pH" Or c.Value = "Count" Or c.Value <= 30 Then
c.EntireColumn.Hidden = False
Else: c.EntireColumn.Hidden = True
End If
Next c
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
"AF2:AF1761"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
"AN2:AN1761"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
"J2:J1761"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:BR1761")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:BR1761").Select
Range("AT9").Activate
Selection.AutoFilter
Selection.AutoFilter
ActiveSheet.Range("$A$1:$BR$1761").AutoFilter Field:=32, Criteria1:= _
"=Shear Rated(gamma)/dt = 4 1/s", Operator:=xlOr, Criteria2:="="
ActiveSheet.Range("$A$1:$BR$1761").AutoFilter Field:=40, Criteria1:= _
"=Viscosity", Operator:=xlOr, Criteria2:="="
End Sub
Basically what it does so far is takes data which is exported from a robot, hides the columns that I don't want and filters the values that I don't want
The problem is that these columns are dynamic and occasionally move around - the macro is able to hide all of the columns I don't want however I'm struggling to make it search for these columns and then filter, right now it is using a recording I did so it selects e.g. column J and then filters
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
"J2:J1761"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
However it may not be on column J it might be at K as occasionally more columns are entered when exporting data
Is there any way to tweak the macro to make it so the auto-filter part actually searches for column headers as opposed to doing these functions on e.g. "J2:J2000" etc.
Thanks a lot apologies that it is long winded I wanted to cover everything

Automatic Multi-level Sorting in VBA

I currently have the following code that works and every time something is typed in, it is automatically sorted by column I
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = 9 Then
Dim lastRow As Long
lastRow = ActiveSheet.Cells.Find(What:="*", LookIn:=xlValues,
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("A2:I" & lastRow).Sort Key1:=Range("I2:I" & lastRow),
Order1:=xlAscending, Header:=xlNo
End If
End Sub
I want it so that it is primarily sorted by item I, but also secondarily sorted by column A. Any help please?
The starting point for any request like this should be "Fire up the macro recorder, perform a sort, and see what code it spits out".
If you fire up the recorder and add a multilevel sort like so:
...then the Macro Recorder spits out this:
Sub Macro11()
'
' Macro11 Macro
'
'
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("I2:I16") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A16") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:I16")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
This gives you a clue as to the syntax you need to add multiple sort keys. Do you need help amending your original code, or is this enough to get you started?

Excel Sorting not working due to Range object

This macro is based off one I recorded, but have tweaked to cope with possible absence of 3 of the 4 sorting criteria. I can't figure out why my Macro works when the range criteria is specific, but not when I'm referencing a single cell and extrapolating.
With this line the sorting works
.SetRange Range("A1:W162")
With this line it doesn't sort.
.SetRange Range("A1").End(xlDown).End(xlToRight)
I've stepped through and can confirm it's selecting the correct range
I don't want use the line with specific cells because future exports will be different sized.
This is the full subroutine (the relevant bit is near the bottom).
Thanks!
Sub SortByScoreAndCost()
Dim Score As Range
Dim Cost As Range
Dim YN As Range
Dim OriginalScore As Range
Set Score = Cells.Find("Score")
Set Cost = Cells.Find("Cost")
Set YN = Cells.Find("Y/N")
Set OriginalScore = Cells.Find("Original Score")
Range("A1").CurrentRegion.Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range( _
Score.Offset(1, 0), Score.End(xlDown)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
If Cells.Find("Cost") Is Nothing _
Then
Else: ActiveSheet.Sort.SortFields.Add Key:=Range _
(Cost.Offset(1, 0), Cost.End(xlDown)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
:=xlSortNormal
End If
If Cells.Find("Y/N") Is Nothing _
Then
Else: ActiveSheet.Sort.SortFields.Add Key:=Range _
(YN.Offset(1, 0), YN.End(xlDown)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
:=xlSortNormal
End If
If Cells.Find("Original Score") Is Nothing _
Then
Else: ActiveSheet.Sort.SortFields.Add Key:=Range _
(OriginalScore.Offset(1, 0), Original.End(xlDown)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
:=xlSortNormal
End If
With ActiveSheet.Sort
.SetRange Range("A1:W162") 'works with this line
.SetRange Range("A1").End(xlDown).End(xlToRight) 'doesn't work if replaced with this line
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Range("A1").End(xlDown).End(xlToRight) refers to a single cell range, not similar to A1:W162. Assuming A1:W162 is the range where all the data on your sheet is. The line refers to W162 only. The Range.End property is explained here and it shows that it does not retain the starting point.
Try Range("A1:"& Range("A1").End(xlDown).End(xlToRight).Address) instead as this should create a range similar to A1:W162. The first part is the string "A1:" and Range("A1).End(xlDown).end(xlToRight).Address returns the string "$W$162" Together they form "A1:$W$162"
With the comment I made on your question in mind I would suggest the code below.
Dim wsData as Worksheet 'Add worksheet variable
Set wsData = ThisworkBook.Worksheets("Name of your data sheet")
With wsData.Sort 'Instead of using ActiveSheet
.SetRange wsData.Range(wsData.Cells(1, 1), wsData.Cells(1, 1).End(xlDown).End(xlToRight))

Resources