I need to create a macro in Excel 2007 that will sort. I don't know how many rows there will be. I know one way to to find the number of rows and how to record sorting, but not how to use these bits of code together.
Sub Sort()
'
' Sort Macro
' *find the last row (assuming no more than 100000 rows)*
Dim Row As Range
Set Row = Range("A100000").End(xlUp).Select
' *code written by recording my sort*
Range("A1:G1").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2:B6376" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("D2:D6376" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("F2:F6376" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:G6376")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
I've tried to put "Row" in multiple places, but I get the RUn-time error '424' Object Required. I need this variable to replace the row number (6376) but not sure how to do it.
I can see where these lines
Range("A1:G1").Select
Range(Selection, Selection.End(xlDown)).Select
are selecting the contents of the workbook, which is what I want, I just don't know how to do it dynamically.
EDIT: I want to sort and subtotal. This is the recorded macro. I need to change the 6376 to be dynamic according to how many rows there are.
Sub Macro4()
'
' Macro4 Macro
'
'
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2:B6376" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("D2:D6376" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("F2:F6376" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:G6376")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(7), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
Selection.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(7), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
End Sub
Thanks.
Not being certain of your data setup, you can try the following, which includes a simple sort routine for columns B, D and F, assuming your data starts in column A (it will also run in 2003, but I guess that's not an issue). I did not include MatchCase below as in your code, it was a matter of the recording, and not necessarily what you want; but you can decide.
EDIT Routine for doing subtotals added
EDIT2 Header parameter added to Sort
Option Explicit
Sub SortAndSubtotal()
Dim RG As Range
Dim WS As Worksheet
Set WS = Worksheets("Sheet2") '<--Change as needed
Set RG = WS.Range("a1").CurrentRegion
With RG
.Sort key1:=.Columns(2), order1:=xlAscending, _
key2:=.Columns(4), order2:=xlAscending, _
key3:=.Columns(6), order3:=xlAscending, _
Header:=xlYes, MatchCase:=False
.Sort key1:=.Columns(1), order1:=xlAscending, Header:=xlYes
End With
'Note that I am just selecting a single cell in the range, since the range will
' expand with each Subtotal. One could also use
' RG.CurrentRegion as the Range Object Expression, but you need to use it
' individually for each .Subtotal operation, to handle the expansion issue.
' Or you could use With RG and then prefix each Subtotal line with .CurrentRegion
With RG(1)
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7), _
Replace:=True, SummaryBelowData:=True
.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(7), _
Replace:=False, SummaryBelowData:=True
.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(7), _
Replace:=False, SummaryBelowData:=True
End With
End Sub
Replace "C" in "C2" with the column you want to sort on.
ActiveWorkbook.Worksheets("Sheet1").UsedRange.Sort key1:=Range("C2"), _
order1:=xlAscending, header:=xlYes
Just sorts the whole sheet. You will get an error if the column at key1 does not exist, which makes pretty sense ;), so make sure it does.
UNTESTED
Try this for me.
Sub Sample()
Dim thisWb As Workbook
Dim ws As Worksheet
Dim lRow As Long
Dim rng As Range
Set thisWb = ThisWorkbook
'~~> Set this to the relevant sheet
Set ws = thisWb.Sheets("Sheet2")
With ws
'~~> Find the last Row. See the below link for more details
'~~> http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lRow = 1
End If
'~~> Set your range
Set rng = .Range("A1:G" & lRow)
With .Sort.SortFields
.Clear
.Add Key:=ws.Range("B2:B" & lRow), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.Add Key:=ws.Range("D2:D" & lRow), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.Add Key:=ws.Range("F2:F" & lRow), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
End With
With .Sort
.SetRange ws.Range("A1:G" & lRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
'~~> Work with the range
With rng
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(7), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(7), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
End With
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.