Sort by Date

[trevormay99]

I have a macro that sorts raw data into multiple sheets formats and arranges them however three sheets need a different type of sorting function then the others

Im trying to sort these three sheets by date in ascending order however I want todays date to be displayed on top followed by the upcoming weeks data in ascending order, once all data from the upcoming week is displayed all other data should be displayed under in ascending order. There is data in columns A-L but the date is contained in column F.

The new module to accomplish this however is not moving todays data and the upcoming week to the top just sorting in ascending order I tried to program a function to convert all the data in colume f to a date string instead of general but still stuck

 

[trevormay99]

Sub SortDataByDate()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim currentDate As Date
    Dim upcomingWeekEnd As Date
    Dim i As Long, j As Long
    Dim tempRow As Range
    Dim sortedRange As Range
    Dim upcomingWeekRange As Range
    
    ' Array of sheet names to process
    Dim sheetNames As Variant
    sheetNames = Array("Prod Meet", "Elec Meet", "Mech Meet")
    
    ' Loop through all worksheets in the workbook
    For Each ws In ThisWorkbook.Worksheets
        ' Check if the sheet name matches one of the specified names
        If UBound(filter(sheetNames, ws.Name)) > -1 Then
            ' Find the last row with data in column F
            lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
            
            ' Loop through each cell in column F and attempt to convert to dates
            For i = 2 To lastRow
                If IsDate(ws.Cells(i, "F").Value) = False Then
                    If IsNumeric(ws.Cells(i, "F").Value) Then
                        ws.Cells(i, "F").Value = DateValue(ws.Cells(i, "F").Value)
                    End If
                End If
            Next i
            
            ' Find today's date
            currentDate = Date
            upcomingWeekEnd = currentDate + 7
            
            ' Loop through each cell in column F
            For i = 2 To lastRow
                If ws.Cells(i, "F").Value >= currentDate And ws.Cells(i, "F").Value <= upcomingWeekEnd Then
                    Set tempRow = ws.Rows(i)
                    tempRow.Copy
                    ws.Rows(2).Insert Shift:=xlDown
                    tempRow.Delete
                End If
            Next i
            
            ' Sort the data by date in ascending order
            Set sortedRange = ws.UsedRange
            sortedRange.Sort Key1:=ws.Range("F2"), Order1:=xlAscending, Header:=xlYes
        End If
    Next ws
End Sub

 

[trevormay99]

Update: I now have the upcoming data from this week shown on the top but the code doesnt apply to the entire range it should apply thru column L and keep each individual row unchanged

How can I apply this sorting function to all data from column A to L?

Sub SortData()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim today As Date
    
    today = Date
    
    ' Sort "Prod Meet" sheet
    Set ws = ThisWorkbook.Sheets("Prod Meet")
    With ws
        lastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
        .Range("A1").AutoFilter Field:=6, Criteria1:=">=" & today
        .Range("A2:G" & lastRow).Sort Key1:=.Range("F2"), Order1:=xlAscending, Header:=xlYes
        .AutoFilterMode = False
    End With
    
    ' Sort "Elec Meet" sheet
    Set ws = ThisWorkbook.Sheets("Elec Meet")
    With ws
        lastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
        .Range("A1").AutoFilter Field:=6, Criteria1:=">=" & today
        .Range("A2:G" & lastRow).Sort Key1:=.Range("F2"), Order1:=xlAscending, Header:=xlYes
        .AutoFilterMode = False
    End With
    
    ' Sort "Mech Meet" sheet
    Set ws = ThisWorkbook.Sheets("Mech Meet")
    With ws
        lastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
        .Range("A1").AutoFilter Field:=6, Criteria1:=">=" & today
        .Range("A2:G" & lastRow).Sort Key1:=.Range("F2"), Order1:=xlAscending, Header:=xlYes
        .AutoFilterMode = False
    End With

 

[johnnyL]

Can you supply some sample data?

 

[trevormay99]

My add on isnt working right now here is a snip until I figure out how to fix the issue

 

[trevormay99]

I cannot get the add in to function it will not give me the option to unblock in properties and the ribbon is greyed out

 

[johnnyL]

See if the following does what you want. FYI, I am not sure if you want date + 7, seems like +6 would be what you want.

Sub SortData()
'
    Dim currentDate         As Date
    Dim upcomingWeekEnd     As Date
    Dim ArrayRow            As Long
    Dim HelperColumnNumber  As Long
    Dim lastRow             As Long
    Dim DateColumnArray     As Variant, HelperColumnArray   As Variant
    Dim sheetNames          As Variant
    Dim ws                  As Worksheet
'
    currentDate = Date                                                                      ' Save today's date to currentDate
    upcomingWeekEnd = currentDate + 7                                                       ' Save the date that is 7 days from today to upcomingWeekEnd
'
    ' Loop through all worksheets in the workbook
    For Each ws In ThisWorkbook.Worksheets                                                  ' Loop through the sheets in the workbook
        Select Case ws.Name
            Case Is = "Prod Meet", "Elec Meet", "Mech Meet"                                 '       If the sheet name matches a sheet that we are looking for then ...
                With ws
                    lastRow = .Cells(.Rows.Count, "F").End(xlUp).Row                        '               Get the lastRow of the date column
                    .Range("A1").AutoFilter                                                 '               Turn on the filter
                    .Range("A1:L" & lastRow).Sort Key1:=.Range("F1"), Order1:=xlAscending, _
                            Header:=xlYes                                                   '               Filter the rows of data ascending according to the dates in column F
                    .AutoFilterMode = False                                                 '               Turn off the filter
'
                    HelperColumnNumber = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 2 '             Get HelperColumnNumber to use
                    DateColumnArray = .Range("F2:F" & lastRow).Value2                       '               Save the dates from column F into DateColumnArray
                End With
'
                ReDim HelperColumnArray(1 To UBound(DateColumnArray), 1 To 1)               '           Establish the dimensions of the HelperColumnArray
'
                For ArrayRow = 1 To UBound(DateColumnArray)                                 '           Loop thru rows of DateColumnArray
                    If DateColumnArray(ArrayRow, 1) >= currentDate And _
                            DateColumnArray(ArrayRow, 1) <= upcomingWeekEnd Then            '               If the date is within the date range then ...
                        HelperColumnArray(ArrayRow, 1) = 1                                  '                   Save '1' to the HelperColumnArray
                    End If
                Next                                                                        '           Loop back
'
                With ws.Range("A2").Resize(UBound(DateColumnArray), HelperColumnNumber)     '
                    .Columns(HelperColumnNumber).Value = HelperColumnArray                  '               Write the HelperColumnArray to the HelperColumnNumber
                    .Sort Key1:=.Columns(HelperColumnNumber), Order1:=xlAscending, _
                            Header:=xlNo                                                    '               Sort the Rows with '1's to the top
                    .Columns(HelperColumnNumber).Delete                                     '               Delete the HelperColumn
                End With
        End Select
    Next                                                                                    ' Loop back
End Sub

 

[trevormay99]

See if the following does what you want. FYI, I am not sure if you want date + 7, seems like +6 would be what you want.

Sub SortData()
'
    Dim currentDate         As Date
    Dim upcomingWeekEnd     As Date
    Dim ArrayRow            As Long
    Dim HelperColumnNumber  As Long
    Dim lastRow             As Long
    Dim DateColumnArray     As Variant, HelperColumnArray   As Variant
    Dim sheetNames          As Variant
    Dim ws                  As Worksheet
'
    currentDate = Date                                                                      ' Save today's date to currentDate
    upcomingWeekEnd = currentDate + 7                                                       ' Save the date that is 7 days from today to upcomingWeekEnd
'
    ' Loop through all worksheets in the workbook
    For Each ws In ThisWorkbook.Worksheets                                                  ' Loop through the sheets in the workbook
        Select Case ws.Name
            Case Is = "Prod Meet", "Elec Meet", "Mech Meet"                                 '       If the sheet name matches a sheet that we are looking for then ...
                With ws
                    lastRow = .Cells(.Rows.Count, "F").End(xlUp).Row                        '               Get the lastRow of the date column
                    .Range("A1").AutoFilter                                                 '               Turn on the filter
                    .Range("A1:L" & lastRow).Sort Key1:=.Range("F1"), Order1:=xlAscending, _
                            Header:=xlYes                                                   '               Filter the rows of data ascending according to the dates in column F
                    .AutoFilterMode = False                                                 '               Turn off the filter
'
                    HelperColumnNumber = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 2 '             Get HelperColumnNumber to use
                    DateColumnArray = .Range("F2:F" & lastRow).Value2                       '               Save the dates from column F into DateColumnArray
                End With
'
                ReDim HelperColumnArray(1 To UBound(DateColumnArray), 1 To 1)               '           Establish the dimensions of the HelperColumnArray
'
                For ArrayRow = 1 To UBound(DateColumnArray)                                 '           Loop thru rows of DateColumnArray
                    If DateColumnArray(ArrayRow, 1) >= currentDate And _
                            DateColumnArray(ArrayRow, 1) <= upcomingWeekEnd Then            '               If the date is within the date range then ...
                        HelperColumnArray(ArrayRow, 1) = 1                                  '                   Save '1' to the HelperColumnArray
                    End If
                Next                                                                        '           Loop back
'
                With ws.Range("A2").Resize(UBound(DateColumnArray), HelperColumnNumber)     '
                    .Columns(HelperColumnNumber).Value = HelperColumnArray                  '               Write the HelperColumnArray to the HelperColumnNumber
                    .Sort Key1:=.Columns(HelperColumnNumber), Order1:=xlAscending, _
                            Header:=xlNo                                                    '               Sort the Rows with '1's to the top
                    .Columns(HelperColumnNumber).Delete                                     '               Delete the HelperColumn
                End With
        End Select
    Next                                                                                    ' Loop back
End Sub

This code works perfectly thanks a bunch, however I have an additional question, is there anyway to limit the amount of columns included in the rows that are moved to the top of the data?
I have a summing function for the hour tabulation in N2-Q3 and when this weeks upcoming data is moved to the top it moves the data in N3-Q3 down which makes the sheet look a little messy. So in short I only need columns A-L to be moved to the top of the sheet, if they fit the criteria of in the upcoming week.

 

[johnnyL]

What do have in the columns N:Q? Are they just values, formulas, text, etc?

Are all sheets going to have these same columns?

Are there any other columns that you have not mentioned?

Is column M blank?

 

[trevormay99]

There is text and formulas, and yes all sheets have the same text and formulas. Here is a snip

I apoligize for the oversight but yes column M is blank