Solved

VBA to Sort and Subtotal

Posted on 2013-12-17
6
352 Views
Last Modified: 2013-12-19
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:

Sub AddSort()

      
        Worksheets("To Open").Sort.SortFields.Add Key:= _
        Range("D15:D66"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal


End Sub

Open in new window



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

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

Open in new window

0
Comment
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
  • Learn & ask questions
  • 3
  • 3
6 Comments
 
LVL 50

Expert Comment

by:Rgonzo1971
ID: 39725924
HI

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

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

Open in new window

Regards
0
 

Author Comment

by:jmac001
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")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Open in new window


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 50

Expert Comment

by:Rgonzo1971
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")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Open in new window

0
Creating Instructional Tutorials  

For Any Use & On Any Platform

Contextual Guidance at the moment of need helps your employees/users adopt software o& achieve even the most complex tasks instantly. Boost knowledge retention, software adoption & employee engagement with easy solution.

 

Author Comment

by:jmac001
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 50

Accepted Solution

by:
Rgonzo1971 earned 500 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)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

Open in new window

Regards
0
 

Author Comment

by:jmac001
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)
        .Header = xlYes
        .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)
        .Header = xlYes
        .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

Open in new window


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

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

730 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question