VBA Convert Column F if there is a date to a Quarter in Same Column

[CLCoop]

I'm new to the VBA world and have been unable to convert Dates to Quarters using VBA code. I have managed to autofill Column F with a date based on when the file is opened MM.DD.YYYY and would like to automate column F to convert to Quarter 1, Quarter 2, Quarter 3, Quarter 4. Not sure what VBA code to use as I know this can be done by hand with an excel code in each cell. Thanks for your insights and recommendations:

To populate Column F with todays date. This could be done better as it fills the spreadsheet when I only need it to go to the end of the records currently in spreadsheet
date_test = Now()
Range("F:F").Select
Range("F:F") = Format(date_test, "MM/DD/YYYY")
[/Code]

Tried to use an auto place a formula in F hoping to convert date into a Quarter (when I run the macro it stays with the original date in the cell) We are on a fiscal year.

Range("F2:F2").Formula = "=""Quarter " & Int(Month(R2) + 2 / 3) - 1
Range("F2:F110").FillDown
[/Code]​

Because of the above is filling the spreadsheet with unwanted rows. This is the code I'm using to delete the unwanted empty rows based on a consistent column
On Error Resume Next
Columns("b").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

[/Code]​

Thanks for helping the lost.
CLCoop

 

[Joe4]

OK, going back to your original question, here is how you could populate cells F2 down to the last row (based on column B) with today's date:

'   Find last row in column B
    lrow = Cells(Rows.Count, "B").End(xlUp).Row
    
'   Populate column F with today's date
    Range("F2:F" & lrow) = Date
    
'   Format column in intended date format
    Columns("F").NumberFormat = "mm/dd/yyyy"

To populate column F with the current quarter instead, use this:

    Dim lrow As Long
    Dim qtr As String
    
'   Find last row in column B
    lrow = Cells(Rows.Count, "B").End(xlUp).Row
    
'   Get current quarter
    Select Case Month(Date)
        Case 1, 2, 3
            qtr = "Quarter 1"
        Case 4, 5, 6
            qtr = "Quarter 2"
        Case 7, 8, 9
            qtr = "Quarter 3"
        Case 10, 11, 12
            qtr = "Quarter 4"
    End Select
    
'   Populate column F with quarter
    Range("F2:F" & lrow) = qtr

 

[CLCoop]

Awesome sauce this worked great! This was the finishing touches on the 1st phase of a 2 week project, think I was brain dead trying to come up with a way to make this work! Thank you. Hopefully your code will live long and work great for future events. I'm not a coder by trade just something that was put on my desk to tackle. Overall there is about 350+ lines of code written to support the 1st phase of a large project. Thank you, tons of hugs!!

 

[Joe4]

You are welcome. Glad I was able to help.