Grouping Data in one Column and Sorting it in another column

[tlaltmey]

Hi,

At the moment, the code I have is written to group data in the "D" Column and sort it in alphanumerical order based off of those numbers. The "E" column consists of a date. What I'd like to do is group all numbers from the "D" column with the same first 7 digits and then sort all of that data by the date in the "E" Column.

IE:

0044982-1

0044982-2

0044982-3

0044982-4

Will all be grouped together with a space in between the next row of numbered data. Then, the overall data will be sorted by the date in the "E" Column. All of the Data from the "D" column will have the same date as the corresponding "E" column.

Current code below:

Sub Filter()

' Deletes Columns Unnecessary Data
   Sheets("Sheet1").Range("B:B, D:D, I:M").EntireColumn.Delete

' Sorts Data in Alpha Numerical Order using Column "D"
Range("D1").Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlYes

' Adds a Spaced Row After each D Data found to be Different
Dim lRow As Long
For lRow = Cells(Cells.Rows.Count, "D").End(xlUp).Row To 2 Step -1
    If Left(Cells(lRow, "D"), 7) <> Left(Cells(lRow - 1, "D"), 7) Then
        ' Adds the Spaced Row
        Rows(lRow).EntireRow.Insert
        ' Adds a gray filled bar in empty rows only to the G column
         Range(Cells(lRow, 1), Cells(lRow, 7)).Interior.ColorIndex = 15
    End If
Next lRow

' Colors the empty rows gray
Dim rng As Range

 On Error Resume Next
 Set rng = Range("A1:G").SpecialCells(xlCellTypeBlanks)
 On Error GoTo 0
 If Not rng Is Nothing Then
 
 rng.Interior.ColorIndex = 15
End If

' Auto Fits Rows and Columns based off of the data
Sheets(1).UsedRange.Columns.AutoFit
Sheets(1).UsedRange.Rows.AutoFit
    
' Creates the Notes Section in G1
Range("G1") = "Notes"

' Creates a border around the data to make it look pretty :)
Range("A1:G" & Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = xlContinuous


Application.ScreenUpdating = True

' Numbers the empty rows by x+1 until the end of active cells/data
lastrow = Cells(Cells.Rows.Count, "D").End(xlUp).Row

inarr = Range(Cells(1, 4), Cells(lastrow, 4))
outarr = Range(Cells(1, 1), Cells(lastrow, 1))
Range(Cells(2, 1), Cells(lastrow, 1)) = "" ' clear column A to put numbering in
indi = 1
For i = 2 To lastrow
  If inarr(i, 1) = "" Then
   outarr(i, 1) = indi
   indi = indi + 1
  End If
Next i
Range(Cells(1, 1), Cells(lastrow, 1)) = outarr

End Sub

I believe this is the line of code that will need to be altered:

' Sorts Data in Alpha Numerical Order using Column "D"
Range("D1").Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlYes

 

[tlaltmey]

Able to resolve on my own by adding the following:

Columns.Sort key1:=Columns("E"), Order1:=xlAscending, Key2:=Columns("D"), Order2:=xlAscending, Header:=xlYes

From originally:

' Sorts Data in Alpha Numerical Order using Column "D" 
Range("D1").Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlYes