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

 

[JackDanIce]

Hi and welcome to the board. Could you provide:

- A few examples of what the dates look like (UK or US format?)
- Confirm, do the dates begin in cell F1 or F2 or other?
- Confirm expected output against the examples you've given, plus what cells the output should be in

Generally speaking the more concise and precise information you can give easier it is to suggest an answer.

Pretend anyone reading your post can't see your PC Monitor, what would help them (e.g. sheet names? Cell locations? Examples of "before" and "after" etc) answer your query best?

 

[Joe4]

Welcome to the Board!

Your post is a bit messy, as you had issues with trying to use Code tags (you are missing the beginning tags). See: https://www.mrexcel.com/forum/board-announcements/515787-how-post-your-vba-code.html

Let's approach this from a different angle. Just explain to us in plain English the structure of your sheet, and exactly what you want to happen.
Include important details like:
- Where is the data currently located (rows/columns)?
- What column can we use to determine where the data ends?
- What cell you want the results to go in?
- What is your exact fiscal year?
- Any other pertinent data.

 

[CLCoop]

Column F auto populates with todays date of 05/30/2018 (I've include the code on the bottom of this post), as we continue to use this same macro the dates will change and I need to get the dates to adjust to the current Quarter based on the date in Column F. I'm trying to build a macro that would:

Convert the Date that is in US format MMDDYYYY = 05/30/2018
That starts in F2 through F117, but in the future there could be less or more rows.

Would like if possible to replace the dates starting in Column F2 and all sequent records with dates convert into Quarters.

IE:
F2 has 05/30/2018
F3 has 08/30/2018
F4 has 12/30/2018

Would like to convert this to
F2 Quarter 2
F3 Quarter 3
F4 Quarter 4

I'm using the following code to auto populate the date in Column F but this fills the entire column within worksheet SOFData rather then just populate the rows with data.

Set ws = ThisWorkbook.Sheets ("SOFData")
date_test = Now()
Range("F:F").Select
Range("F:F") = Format(date_test, "MM/DD/YY")
after this code would like to convert the date into Quarters as shown above.

thanks for helping hope this makes things easier.
​

 

[Joe4]

Your code would never do this:

IE:
F2 has 05/30/2018
F3 has 08/30/2018
F4 has 12/30/2018

Would like to convert this to
F2 Quarter 2
F3 Quarter 3
F4 Quarter 4

This code:

[COLOR=#222222][FONT=Verdana]Set ws = ThisWorkbook.Sheets ("SOFData")[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]date_test = Now()[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]Range("F:F").Select[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]Range("F:F") = Format(date_test, "MM/DD/YY")[/FONT][/COLOR]

will populate EVERY single cell in column F with today's date.
That is why I asked this question:

- What column can we use to determine where the data ends?

Is column F already populated with dates before the VBA code runs, and is your goal just to convert those dates to quarters?
If not, how can we determine how many cells in column F to populate with today's date? Is there another column that has data in it, that shows us how far we need to do down column F?

 

[CLCoop]

yep need to change the code to NOT fill the entire F Column spreadsheet but only to the point where the records end which could vary based on more or less expenditures.

​

Set ws = ThisWorkbook.Sheets ("SOFData")​

date_test = Now()​

Range("F:F").Select​

Range("F:F") = Format(date_test, "MM/DD/YY")​

If it makes it easier I could make another column as to not overwrite Column F (Date). I could add another column G (quarter). Might make it easier for the code to look at Column F dates and then Update G with Quarters?

Thoughts on what this might look like without auto filling rows that have no other data?

 

[JackDanIce]

This will overwrite column F as per what I think you initially asked.

Column F is column 6 (F 6th letter of alphabet, I prefer to use column index numbers), so adjust below if you want the output to go into a different column:

Sub TransformDatesToQs()

    Dim x       As Long
    Dim arr()   As Variant
    Const QUART As String = "Quarter "
    
    x = Cells(Rows.Count, 6).End(xlUp).row
    arr = Cells(2, 6).Resize(x - 1).Value
    
    For x = LBound(arr, 1) To UBound(arr, 1)
        Select Case CLng(Left$(arr(x, 1), 2))
            Case Is < 4: arr(x, 1) = QUART & 1
            Case Is < 7: arr(x, 1) = QUART & 2
            Case Is < 10: arr(x, 1) = QUART & 3
            Case Else: arr(x, 1) = QUART & 4
        End Select
    Next x
    
    Cells(2, 6).Resize(x - 1).Value = arr
    
    Erase arr
    
End Sub

 

[Joe4]

yep need to change the code to NOT fill the entire F Column spreadsheet but only to the point where the records end which could vary based on more or less expenditures.

I am still not clear on one thing.
Is column already populated with dates, or is it blank to start and you are trying to populate it with the current date?

If you are trying to populate it, you said the ending point of column F depends on the expenditures. Where are the expenditures listed? In what column?

 

[CLCoop]

Ugh for a second I got Quarters but it over wrote the next column(H(8) Budgeted). So I went back and added code to add another column between F(6) date (US 05/30/2019) and H(8)budget called G(7) Quarter (no data in it). For some reason now I get dates in both columns F(6) and G(7)

A (1): B(2): C(3): D(4) E(5) F(6) G(7) H(8)​

[TABLE="width: 714"]
<colgroup><col><col><col><col><col><col span="2"><col></colgroup><tbody>[TR]
[TD]Fiscal Year[/TD]
[TD]area[/TD]
[TD]region[/TD]
[TD]district[/TD]
[TD] BOC[/TD]
[TD] Date[/TD]
[TD] Quarter [/TD]
[TD] Budgeted [/TD]
[/TR]
[TR]
[TD][/TD]
[TD]RD1SL00000 [/TD]
[TD]RD1SL00000 [/TD]
[TD]RD1SL00000 [/TD]
[TD] 0000[/TD]
[TD="align: right"]5/30/2018[/TD]
[TD="align: right"] 5/30/2018[/TD]
[TD="align: right"]$249.02 [/TD]
[/TR]
[TR]
[TD][/TD]
[TD]RD1SL00000 [/TD]
[TD]RD1SL00000 [/TD]
[TD]RD1SL00000[/TD]
[TD] 1170/1170[/TD]
[TD="align: right"]5/30/2018[/TD]
[TD="align: right"]5/30/2018[/TD]
[TD="align: right"]$13.03

[/TD]
[/TR]
</tbody>[/TABLE]
Ran original code came back and over wrote budgeted (H8) column:

A (1): B(2): C(3): D(4) E(5) F(6) H(8)​

[TABLE="width: 714"]
<colgroup style="background-attachment: scroll; background-clip: border-box; background-color: transparent; background-image: none; background-origin: padding-box; background-position-x: 0%; background-position-y: 0%; background-repeat: repeat; background-size: auto; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-size-adjust: none; font-stretch: normal; font-style: normal; font-variant: normal; font-weight: 400; line-height: normal; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px; padding-bottom: 0px; padding-left: 0px; padding-right: 0px; padding-top: 0px;"><col style="background-attachment: scroll; background-clip: border-box; background-color: transparent; background-image: none; background-origin: padding-box; background-position-x: 0%; background-position-y: 0%; background-repeat: repeat; background-size: auto; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-size-adjust: none; font-stretch: normal; font-style: normal; font-variant: normal; font-weight: 400; line-height: normal; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px; padding-bottom: 0px; padding-left: 0px; padding-right: 0px; padding-top: 0px;"><col style="background-attachment: scroll; background-clip: border-box; background-color: transparent; background-image: none; background-origin: padding-box; background-position-x: 0%; background-position-y: 0%; background-repeat: repeat; background-size: auto; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-size-adjust: none; font-stretch: normal; font-style: normal; font-variant: normal; font-weight: 400; line-height: normal; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px; padding-bottom: 0px; padding-left: 0px; padding-right: 0px; padding-top: 0px;"><col style="background-attachment: scroll; background-clip: border-box; background-color: transparent; background-image: none; background-origin: padding-box; background-position-x: 0%; background-position-y: 0%; background-repeat: repeat; background-size: auto; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-size-adjust: none; font-stretch: normal; font-style: normal; font-variant: normal; font-weight: 400; line-height: normal; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px; padding-bottom: 0px; padding-left: 0px; padding-right: 0px; padding-top: 0px;"><col style="background-attachment: scroll; background-clip: border-box; background-color: transparent; background-image: none; background-origin: padding-box; background-position-x: 0%; background-position-y: 0%; background-repeat: repeat; background-size: auto; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-size-adjust: none; font-stretch: normal; font-style: normal; font-variant: normal; font-weight: 400; line-height: normal; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px; padding-bottom: 0px; padding-left: 0px; padding-right: 0px; padding-top: 0px;"><col style="background-attachment: scroll; background-clip: border-box; background-color: transparent; background-image: none; background-origin: padding-box; background-position-x: 0%; background-position-y: 0%; background-repeat: repeat; background-size: auto; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-size-adjust: none; font-stretch: normal; font-style: normal; font-variant: normal; font-weight: 400; line-height: normal; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px; padding-bottom: 0px; padding-left: 0px; padding-right: 0px; padding-top: 0px;"><col style="background-attachment: scroll; background-clip: border-box; background-color: transparent; background-image: none; background-origin: padding-box; background-position-x: 0%; background-position-y: 0%; background-repeat: repeat; background-size: auto; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-size-adjust: none; font-stretch: normal; font-style: normal; font-variant: normal; font-weight: 400; line-height: normal; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px; padding-bottom: 0px; padding-left: 0px; padding-right: 0px; padding-top: 0px;" span="2"><col style="background-attachment: scroll; background-clip: border-box; background-color: transparent; background-image: none; background-origin: padding-box; background-position-x: 0%; background-position-y: 0%; background-repeat: repeat; background-size: auto; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-size-adjust: none; font-stretch: normal; font-style: normal; font-variant: normal; font-weight: 400; line-height: normal; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px; padding-bottom: 0px; padding-left: 0px; padding-right: 0px; padding-top: 0px;"></colgroup><tbody style="background-attachment: scroll; background-clip: border-box; background-color: transparent; background-image: none; background-origin: padding-box; background-position-x: 0%; background-position-y: 0%; background-repeat: repeat; background-size: auto; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-size-adjust: none; font-stretch: normal; font-style: normal; font-variant: normal; font-weight: 400; line-height: normal; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px; padding-bottom: 0px; padding-left: 0px; padding-right: 0px; padding-top: 0px;">[TR="bgcolor: transparent"]
[TD]Fiscal Year[/TD]
[TD] area[/TD]
[TD]region[/TD]
[TD]district[/TD]
[TD] BOC[/TD]
[TD] Date[/TD]
[TD] [/TD]
[TD] Budgeted [/TD]
[/TR]
[TR="bgcolor: transparent"]
[TD]Projected [/TD]
[TD="bgcolor: transparent"] D1SL00000 [/TD]
[TD="bgcolor: transparent"]RD1SL00000 [/TD]
[TD="bgcolor: transparent"]RD1SL00000 [/TD]
[TD="bgcolor: transparent"] 0000[/TD]
[TD="bgcolor: transparent, align: right"]5/30/2018[/TD]
[TD="bgcolor: transparent, align: right"][/TD]
[TD="bgcolor: transparent, align: right"]Quarter 4
[/TD]
[/TR]
[TR="bgcolor: transparent"]
[TD]Projected[/TD]
[TD="bgcolor: transparent"] RD1SL00000 [/TD]
[TD="bgcolor: transparent"]RD1SL00000 [/TD]
[TD="bgcolor: transparent"]RD1SL00000[/TD]
[TD="bgcolor: transparent"] 1170/1170[/TD]
[TD="bgcolor: transparent, align: right"]5/30/2018[/TD]
[TD="bgcolor: transparent, align: right"][/TD]
[TD="bgcolor: transparent, align: right"]Quarter 4 [/TD]
[/TR]
</tbody>[/TABLE]

 

[CLCoop]

F is not populated at the start. I used code to autofill with todays date as it will need to do this going forward. I tend to use the B column (Area) cause this is always filled thus if we count up from the bottom where B (Area) is filled it should give us how far for F(date) to auto fill? Not sure how to write it.

There is a lot of code going on to convert this form into a something that can be incorporated into another database and excel spreadsheet. Without giving loads of line of code I'm copying the area that directly impacts columns F(6), G(7), and A(1). F(6) Date autofills with todays day, G(7) will hopefully update with Quarter based on F(6) date, and A1 is reading F(6) to configure what FY year it is.

'this just names the column for easy use
Range ("F1").Select
ActiveCell.FormulaR1C1= "Date"

'this autofills F(Date) column based on todays date other wise this column is blank/empty, need to be filled based on the date the file is opened and will impact Column A(1) for Fiscal Year and Column G (7) Quarter assignments. If there is a better code please let me know, I'd rather have date filled based on if there is anything in column B (Area) as to not create additional records. (Help on this code)
Date_test = Now()
Range ("F2:F200").Select
Range ("F2:F200") = Format(date_test, "MM/DD/YYYY")

on error resume next

'This inserts a column as to allow room for Quarters to have a place to auto populate
Columns ("G:G").Select
Selection.Insert Shift:=x1toright, CopyOrigin:=x1FormateFromLeftOrAbove
Row("7,7").Select
Selection.Insert Shift:=x1Down, CopyOrigin:=x1FormateFromLeftOrAbove

'This just labels the column for easy use
Range ("G1").Select
ActiveCell.FormulaR1C1 = "Quarter"

'This is working great to fill Column A Budgeted Amount FY year based on what date is in the F(Date) column.
Set ws = Sheets ("SOFData")
lr = ws.Cells(Rows.Count, "F").End(x1Up).row
For x = 2 To lr
If ISEmpty(Cells(x,"A")) Then
fy=Right(year(Cells(x,"F")),2)
Cells(x,"A") = "FY" & fy & " Budgeted Amount"

End if
Next x

Erase arr
[/code]

'This is in the code that deletes the extra stuff, cause I'm not good at coding "only fill if there is a record" so this cleans up based on column B as this never should be blank, hope this goes away if I can figure out coding to only fill if there is a record not the entire column
On Error Resume Next
Columns ("B").SpecialCells(x1CellTypeBlanks).EntireRow.Delete

What I'm aiming (should look like) for the VBA code to automate G(7) Quarter based on F(6) Date. G(7) Quarter is a column that is added in the code and is empty.

A(1) (Fiscal Year)...............B(2) Area......C(3) Region.......D(4) District......E(5) BOC........F(6) Date.........G(7) Quarter............H(8) Budgeted
1 FY18 Budget Amount .......123..............456..................789..................Overtime........05/30/2018......Quarter 3 ................$2000.00
2 FY19 Budget Amount .......123..............456 .................789..................Supplies.........01/30/2017......Quarter 1 ................$50.00​