简体   繁体   中英

VBA - How to identify max date in a column and save file with current year and month if the max date is in the current month

This is a two part problem that I'm trying to solve. First, I'd like to identify the max date in a column. If the max date is in the current month, then I'd like to save the file in the current format using the current year and month (filename YYYYMM). If the date is less than the current month, I'd like to save the file with current year and prior month.

This is the code I've started off with to identify the max date but my MsgBox display the time instead of date so I can't confirm if it's actually working.

Dim Max_date As Date
xl.Sheets("Data").Visible = True
xl.Sheets("Data").Select
xl.Range("I:I").Select
Max_date = Application.WorksheetFunction.Max(xl.Range("I:I"))
MsgBox Max_date

please take the time to check the code and configure all you need. Good luck

'This es the configurable part
Sub Export()
    Dim filePath As String, fileName As String
    filePath = OpenFileExplorer(msoFileDialogFolderPicker) '"" 'define your save path         or use -->'OpenFileExplorer(msoFileDialogFolderPicker)
    fileName = "eg. 09_03_2021" 'here you code max, remember dont use slash
    Copy_Save_Worksheet_As_Workbook "your Sheet to save", fileName, filePath
End Sub

'Starting a procedure to save a worksheet as new workbook
Public Sub Copy_Save_Worksheet_As_Workbook(SheetNameToCopy_ As String, saveAs__ As     String, path_ As String)
    Application.ScreenUpdating = False
    Dim wkb As Workbook
    'Check this line too
    Const fileExtencion = ".xlsx"
    'this is to check if already book open with same name
    For Each wkb In Workbooks
        If wkb.Name = saveAs__ & fileExtencion Then
            Workbooks(wkb.Name).Close False
        End If
    Next
   
    Dim finalPath As String
    finalPath = path_ & "\" & saveAs__
    ThisWorkbook.Sheets(SheetNameToCopy_).Select
    ActiveSheet.Copy
    ActiveSheet.SaveAs fileName:=finalPath & ".xlsx"
    Application.ScreenUpdating = True
 End Sub

Public Function OpenFileExplorer(t_ As MsoFileDialogType) As String
    Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(t_)
   With fd
      .AllowMultiSelect = False

      ' Set the title of the dialog box.
      .Title = "Where to save"

      ' Clear out the current filters, and add our own.
      .Filters.Clear
     If t_ = msoFileDialogFilePicker Then
          .Filters.Add "All Files", "*.*"
     End If
     If .Show = True Then
         OpenFileExplorer = .SelectedItems(1)
     Else
        OpenFileExplorer = ""
     End If
   End With
End Function

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