VBA - How to rename an Excel file based on the value in a Column

[Dhoang25]

Hi,

I'm trying to rename a file based on two values in column A (Cell A2) and in column B (Cell B2). In my Excel spreadsheet, it has 3 columns:

Column A - Customer Name,
Column B - Giving Date (11/30/2020)
Column C - Giving Amount ($)

Column A has ONLY 1 customer (John Doe)
Column B has multiple dates (1/31/2020, 2/28/2020, 3/31/2020 etc.)

I need the VBA to create a new file with a different name. It should be in this format "2020.11.30_John Doe_Giving Statement"

The date must be the most recent date. Maybe sort it (descending) first?

Big thanks for your help!

-Dan

[Ochimus]

Dhoang,

Not tested, but try this:

Option Explicit
Dim LastRow As Long
Dim max_dat As Date
Dim ws As Worksheet

Sub test()

Set ws = ThisWorkbook.Worksheets("Sheet3") ' Change to your actual sheet:

Find last row with date in Col B

    With ws
        f = .Cells(.Rows.Count, "B").End(xlUp).Row

'Find latest date in the range

max_dat = Application.WorksheetFunction.Max(ws.Range("B2:B" & f))

'Use that in File Name:

ActiveWorkbook.SaveAs Filename:=max_dat & "_" & range("A2").value & "_Giving Statement"

End with

End Sub

Hope this helps

Ochimus

[Greg M]

Hi there,

See if the following code does what you need:

Option Explicit


Sub CreateWorkbook()

    Const sCOLUMN_DATES As String = "B"
    Const sCOLUMN_NAME  As String = "A"
    Const sFILE_SUFFIX  As String = ".xlsx"
    Const sSHEET_NAME   As String = "Sheet1"

    Dim dteLatestDate   As Date
    Dim sLatestDate     As String
    Dim rDateCells      As Range
    Dim sCustomer       As String
    Dim sFileName       As String
    Dim wks             As Worksheet

    Set wks = ThisWorkbook.Worksheets(sSHEET_NAME)

    With wks

        sCustomer = .Columns(sCOLUMN_NAME).Cells(1, 1).Value

        Set rDateCells = Intersect(.UsedRange, _
                                   .Columns(sCOLUMN_DATES))

        dteLatestDate = WorksheetFunction.Max(rDateCells)

        sLatestDate = Format(dteLatestDate, "yyyy.mm.dd")

        sFileName = sLatestDate & "_" & sCustomer & "_Giving Statement" & sFILE_SUFFIX

        wks.Copy

        ActiveWorkbook.SaveAs Filename:=sFileName

    End With

End Sub

The highlighted values may be altered to suit your requirements.


Hope this helps - please let me know how you get on.

Regards,

Greg M