Sorting a moving range.

**tmboggs10** · 11-07-2012, 06:59 PM

Hey everyone,

I will place the code below, but basically need to know how to add a sort code for a section of data that is not always on specific lines. In other words I have data at the top that is already coded to format the way I need, but I add a couple of line after the top data and what needs to be below. This second range of data may start on row 5 this time and row 2000 next time, and it may stop on row 10 or row 6000. I need it to select this area of data and sort it by column Q and then column R, but only for this data not the data above. I need this code inserted after the "q=q+1" line in the section where it says "This section sums up the Expenditure values in column S". Hopefully I have provided enough info. Please let me know if you need more. I appreciate any help I can get.

Sub DavidsActivityMacro()
'
' DavidsActivityMacro Macro
'
' Keyboard Shortcut: Ctrl+g
'
Dim i, j, k, p, q, R, s, numRevenue, numLiability, numAsset, numTotal As Integer, sheetName, title, msg As String, style As VbMsgBoxStyle, result As VbMsgBoxResult


    'Defining variables so they will reset to 0 each time the macro is run.
    numRevenue = 0
    numLiability = 0
    numAsset = 0
    numTotal = 0
    
    'Asking for the Sheet name of the workbook to avoid errors
    sheetName = InputBox("Please enter the name (case-sensitive) of" & Chr(10) & "the first sheet in the workbook (e.g. Sheet1): ")
    
    'Deleting the first row and also checking for errors in the sheetName variable before any action is taken
    Worksheets(sheetName).Activate
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    
    'Changing Font to Times New Roman
    Cells.Select
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    
    'Fitting all the columns
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
    Columns("J:J").EntireColumn.AutoFit
    Columns("K:K").EntireColumn.AutoFit
    Columns("L:L").EntireColumn.AutoFit
    Columns("M:M").EntireColumn.AutoFit
    Columns("N:N").EntireColumn.AutoFit
    Columns("O:O").EntireColumn.AutoFit
    Columns("P:P").EntireColumn.AutoFit
    Columns("Q:Q").EntireColumn.AutoFit
    Columns("R:R").EntireColumn.AutoFit
    Columns("S:S").EntireColumn.AutoFit
    Columns("T:T").EntireColumn.AutoFit
    
    'This sorts all the data by "Account" (Column F) and by "Date" (Column R)
    ActiveWorkbook.Worksheets(sheetName).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(sheetName).Sort.SortFields.Add Key:=Range("F:F") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(sheetName).Sort.SortFields.Add Key:=Range("R:R") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(sheetName).Sort
        .SetRange Range("A1:T10000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'This finds AP and Cash Clearing and deletes them
    With Selection.AutoFilter
    ActiveSheet.Range("$A$1:$T$10000").AutoFilter Field:=6, Criteria1:="=111999" _
        , Operator:=xlOr, Criteria2:="=210100"
    Range("A2:A10000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Selection.AutoFilter
    End With
    
    'This finds where the REVENUE section starts and adds rows above it
    Range("Q1").Select
    For i = 1 To 10000
        ActiveCell.Offset(1, 0).Select
        If ActiveCell.Value = "REVENUE" Then Exit For
    Next i
    
    'Adding rows
    Rows(ActiveCell.Row).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
    'This copies the first row and pastes it above the "REVENUE" section
    Rows("1:1").Select
    Selection.Copy
    
    Range("Q1").Select
    For i = 1 To 10000
        ActiveCell.Offset(1, 0).Select
        If ActiveCell.Value = "REVENUE" Then Exit For
    Next i
    
    Rows(ActiveCell.Row).Offset(-1, 0).Select
    ActiveSheet.Paste
    
    'Selecting all the data above the "REVENUE" section
    Range("Q1").Select
    For i = 1 To 10000
        ActiveCell.Offset(1, 0).Select
        If ActiveCell.Value = "" Then Exit For
        If ActiveCell.Value = "ASSET" Then numAsset = numAsset + 1
        If ActiveCell.Value = "LIABILITY" Then numLiability = numLiability + 1
    Next i
    
    numTotal = numAsset + numLiability + 1
    
    Range("A1:T" & numTotal).Select
    
    'Performing a Subtotal of the above selection
    Selection.Subtotal GroupBy:=6, Function:=xlSum, TotalList:=Array(19), _
    Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    
    
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''This section sums up the Expenditure values in column S.'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    'Using integers defined at beginning of macro
    q = 0
    R = 0
    
    'This finds the row where the "REVENUE" section starts
    Range("Q1").Select
    For p = 1 To 10000
        If ActiveCell.Value = "REVENUE" Then Exit For
        q = q + 1
        ActiveCell.Offset(1, 0).Select
    Next p
    q = q + 1    
    'Subtotal Revenue and Expenditure sections
    Selection.Subtotal GroupBy:=17, Function:=xlSum, TotalList:=Array(19), _
    Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    
    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    'Finally, this puts a comma in the S Column
    Range("S1:S10000").Select
    Selection.style = "Comma"
    
    'Just selecting the first cell in the workbook to end on
    Range("A1").Select
    
End Sub

Thanks,

Thomas.

**rylo** · 11-07-2012, 09:35 PM

Hi

What data columns are to be involved (A-T)? How do you find the last row of the data to be sorted? Is it the last row of data in column Q?

rylo

**tmboggs10** · 11-07-2012, 09:51 PM

A-T all contain data that needs to be selected. I do not have anything to find the last row, but the last row needs to be included in the selection. Basically need to select the entire data after the lines inserted and sort by column q (type) and column r (date).

**rylo** · 11-07-2012, 11:37 PM

Hi

Assuming that there will always be something in column A for every row (if not, then use a relevant column) then try something like

range("A" & q & ":T" & cells(rows.count,1).end(xlup).row).sort key1:=range("Q" & q), order1:=xlascending, key2:=range("R" & q), order2:=xlascending, header:=xlno

rylo