Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
Solved

# VBA to Sort and Subtotal

Posted on 2013-12-17
Medium Priority
380 Views
Hi need assistance with creating vba to Sort.   The header for the data is on Row 14, data starts in 15.  The first sort is on column D (Type).  Once this is sorted I then need to sort based on Column D value = If Col D = LM then I need to sort on Columns D (Type),E (Partner), J (Date).  If Col D=TR then sort by D (Type), F (Fitter), E (Partner),  J (Date).

This is the code I have but it is not working, no error given:

Range("D15:D66"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal

End Sub

Once I have that formatted I will be able to incorporate the code that I have for the subtotal which is:

Worksheets("To Open").Activate
Selection.Subtotal GroupBy:=5, Function:=xlAverage, TotalList:=Array(11, _
12, 13, 16, 17), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
0
Question by:jmac001
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• 3
• 3

LVL 53

Expert Comment

ID: 39725924
HI

to sort pls try ( Change the area to be sorted )

Range("D15:D66"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With Worksheets("To Open").Sort
.SetRange Range("A14:J66") ' Select the range to be sorted
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Regards
0

Author Comment

ID: 39727334
Could not get the above to work, however I did record the macro again just for the first part of the stort and it works:

Sub Test()
'
' Test Macro
'
ActiveWorkbook.Worksheets("To Open in '13").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("To Open in '13").Sort.SortFields.Add Key:= _
Range("D15:D65"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("To Open in '13").Sort
.SetRange Range("B14:R65")
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

How do I incorporate the additional sorting that I need?  If Col D = LM then I need to sort on Columns D (Type),E (Partner), J (Date).  If Col D=TR then sort by D (Type), F (Fitter), E (Partner),  J (Date).
0

LVL 53

Expert Comment

ID: 39727393
if the F column is empty or all the same for ColD = LM then

try

ActiveWorkbook.Worksheets("To Open in '13").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("To Open in '13").Sort.SortFields.Add Key:=Range("D15:D65" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("To Open in '13").Sort.SortFields.Add Key:=Range("E15:E65" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("To Open in '13").Sort.SortFields.Add Key:=Range("F15:F65" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("To Open in '13").Sort.SortFields.Add Key:=Range("J15:J65" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("To Open in '13").Sort
.SetRange Range("D15:J65")
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
0

Author Comment

ID: 39727430
The F Column is empty for all of the rows with LM, however it is filled in for the rows with TR so the code above get me closer, now I just need to get the data with TR in Column D to sorted by  D (Type), F (Fitter), E (Partner),  J (Date).

Also is there a way to make dynamic so that as I add additional rows of data I don't have to adjust the code?
0

LVL 53

Accepted Solution

Rgonzo1971 earned 2000 total points
ID: 39728485
pls try

Sub macro2()

LastRow = ActiveWorkbook.Worksheets("To Open in '13").Range("D15").End(xlDown).Row
ActiveWorkbook.Worksheets("To Open in '13").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("To Open in '13").Sort.SortFields.Add Key:=Range("D15:D" & LastRow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("To Open in '13").Sort.SortFields.Add Key:=Range("E15:E" & LastRow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("To Open in '13").Sort.SortFields.Add Key:=Range("F15:F" & LastRow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("To Open in '13").Sort.SortFields.Add Key:=Range("J15:J" & LastRow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("To Open in '13").Sort
.SetRange Range("D15:J" & LastRow)
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub
Regards
0

Author Comment

ID: 39729658
Rgonzo1971,

Thanks for your assistance tweek a little bit (had to run code on column d first, then the remaining criteria and switch columns E and F) so that I got the results that I was looking for but the sort and subtotal are now working as expected.  Here is the code that I ended up with:

Dim LM As Long, i As Long

LM = Range("D" & Rows.Count).End(xlUp).Row

LastRow = ActiveWorkbook.Worksheets("VSBA To Open in '13").Range("B14").End(xlDown).Row
ActiveWorkbook.Worksheets("VSBA To Open in '13").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("VSBA To Open in '13").Sort.SortFields.Add Key:=Range("D15:D" & LastRow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("VSBA to Open in '13").Sort
.SetRange Range("B14:R" & LastRow)
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

LastRow = ActiveWorkbook.Worksheets("VSBA To Open in '13").Range("D15").End(xlDown).Row
ActiveWorkbook.Worksheets("VSBA To Open in '13").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("VSBA To Open in '13").Sort.SortFields.Add Key:=Range("D15:D" & LastRow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("VSBA To Open in '13").Sort.SortFields.Add Key:=Range("F15:F" & LastRow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("VSBA To Open in '13").Sort.SortFields.Add Key:=Range("E15:E" & LastRow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("VSBA To Open in '13").Sort.SortFields.Add Key:=Range("J15:J" & LastRow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("VSBA To Open in '13").Sort
.SetRange Range("B14:R" & LastRow)
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

For i = 1 To LM

If Value = "Local Market" Then
Worksheets("VSBA to Open in '13").Activate
Selection.Subtotal GroupBy:=6, Function:=xlAverage, TotalList:=Array(11, _
12, 13, 16, 17), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Else

Worksheets("VSBA to Open in '13").Activate
Selection.Subtotal GroupBy:=5, Function:=xlAverage, TotalList:=Array(11, _
12, 13, 16, 17), Replace:=True, PageBreaks:=False, SummaryBelowData:=True

End If

Next i

End Sub

It could probably be cleaned up to run effieciently, but it works.
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will diâ€¦
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns overâ€¦
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaacâ€¦
###### Suggested Courses
Course of the Month12 days, 7 hours left to enroll