简体   繁体   中英

Custom Macro in Excel with Selection and Sorting

I have a large Excel file that contains a lot of data that needs to be sorted.

The first row contains the column headers, the second row contains a location, and the third row starts with the data. Once the data for a each location ends, there is one blank row, followed by the location name in the next row, and then the data again. This process repeats 18 times.

I'm trying to write a macro that starts grabbing data at A3, which is the first column that contains data, and span it across to column G, then down until the first blank line. Once it finds the selection, it should sort by Columns C, then Column B.

I have the entire first iteration written and working, but I'm not sure how to get this to find the next column where data is housed.

Essentially after each blank line, there is one row, then the data, which is what I'm looking for.

I'm writing this in VBA.

Sub DataCleanup()
'Rows("1:3").EntireRow.Select
'Selection.Delete Shift:=xlUp
For i = 1 To 18
    Range("A3:G" & Range("A1").End(xlDown).Row).Select
    'Sort the rows C, B
    Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Key2:=Range("B1") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
    Next
End Sub

Maybe this will work. I took the liberty of removing the hard-coded assumption there will always be 18 blocks of data. This will loop through as many blocks as you have and stop when it hits the bottom of the workbook. My assumption, therefore, is you don't have something below the 18th block that you do not wish to be sorted.

Sub DataCleanup()
Dim TopLeft As Range
Dim SortRange As Range

Set TopLeft = Range("A2")
Do
    Set TopLeft = TopLeft.Offset(1, 0)
    Set SortRange = Range(Range(TopLeft, TopLeft.End(xlDown)), TopLeft.End(xlToRight))
    SortRange.Select ' this line for show only, should be commented out
    SortRange.Sort Key1:=Range("C1"), Order1:=xlAscending, Key2:=Range("B1") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
    Set TopLeft = TopLeft.End(xlDown).End(xlDown)
Loop Until TopLeft.Row = ActiveSheet.Rows.Count
End Sub

Notes:

  1. I changed the starting position to $A$2 . This just sets up the loop appropriately (assuming there is at least one block to sort).
  2. SortRange.Select can safely be commented out. I only left it there in case you want to visualize what the code is working on.
  3. Protip: you might want to change the Sort Header parameter to xlNo since the data range definitely does not contain headers.
"Essentially after each blank line, there is one row, then the data..."  

As per the information you provided, the below code assumes that you don't want to sort that next line after the blank row.

Private Sub SortLocations()

Dim firstAddress As String
Dim lastRow As Long
Dim Rng As Range
Dim R As Range

With ActiveSheet
    'Set the entire range to work with.
    lastRow = Range("A:A").Find("*", searchdirection:=xlPrevious).Row
    Set Rng = .Range("A1:A" & lastRow)

    'Sort the first group of locations.
    .Range("A3:G" & .Range("A1").End(xlDown).Row).Sort _
        Key1:=.Range("C1"), Order1:=xlAscending, _
        Key2:=.Range("B1"), Order2:=xlAscending, _
        HEADER:=xlGuess, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom

    Set R = Rng.Find(vbNullString)
    If Not R Is Nothing Then
        firstAddress = R.Address
        Do
            'Sort each subsequent group locations.
            .Range(R.Offset(2, 0), .Range("G" & R.Offset(2, 0).Row).End(xlDown)).Sort _
                Key1:=.Range("C" & R.Offset(2).Row), Order1:=xlAscending, _
                Key2:=.Range("B" & R.Offset(2).Row), Order2:=xlAscending, _
                HEADER:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
            'Find next empty cell
            Set R = Rng.FindNext(R)
        Loop While Not R Is Nothing And R.Address <> firstAddress
    End If
End With
End Sub

For your reference: .FindNext

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM