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

 

[johnnyL]

What columns in your sheet have formulas?

 

[trevormay99]

N,O,P & Q all have sum formulas

 

[johnnyL]

I haven't tested this, I redid some of the strategy:

Sub SortDataV2()
'
    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 = 1                                                  '               Set HelperColumnNumber to use
                    DateColumnArray = .Range("F2:F" & lastRow).Value2                       '               Save the dates from column F into DateColumnArray
'
                    .Columns("A:A").Insert                                                  '               Insert the helper column
                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), 13)                     '
                    .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

Let us know how it goes.

 

[trevormay99]

I haven't tested this, I redid some of the strategy:

Sub SortDataV2()
'
    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 = 1                                                  '               Set HelperColumnNumber to use
                    DateColumnArray = .Range("F2:F" & lastRow).Value2                       '               Save the dates from column F into DateColumnArray
'
                    .Columns("A:A").Insert                                                  '               Insert the helper column
                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), 13)                     '
                    .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

Let us know how it goes.

The formulas are now in the correct spot but they did not sum like they were supposed to, the text in row 1 columns N:Q all shifted over oner and also it expanded the size of all the cells

 

[johnnyL]

I think you might want to supply an example of your starting data with XL2BB, or provide a link to a sample file that we can look at.