Quarter from date in another column

[Serafin54]

Hi everyone,

I have this code below that for the most part works well but needs help. When I have dates for employees in any column (it does float so not always in col C) i need to know the Time Period in the cell to the left. This list can be quite long or as short as you see now. Currently with the code below, I highlight the entire column and run the vba which inserts a column to the left and the the verbage needed depending on the date. Most of the time it works. Problem I run into is sometimes it doesn't work at all and i don't know why. But it also pastes the results as formulas instead of values. I am not sure what to change to get it to always work and also to put the results in as values instead of formulas so any and all help is greatly appreciated.

Before:

Worker ID	Worker Name	Check Date
1027	Sorensen,Robert	06/15/2021
1027	Sorensen,Robert	07/04/2021
1030	Dickinson,Timothy	06/15/2021
1030	Dickinson,Timothy	07/04/2021
1034	Mooney,Brad	06/15/2021
1034	Mooney,Brad	07/04/2021
1041	Adams,Kathleen	06/15/2021
1041	Adams,Kathleen	07/04/2021
1041	Adams,Kathleen	10/01/2021
1042	Anderson,Christopher	06/15/2021
1042	Anderson,Christopher	07/04/2021
1055	Mills-Halso,Susan	06/15/2021
1055	Mills-Halso,Susan	07/04/2021
1079	McBride,Rodney	06/15/2021
1079	McBride,Rodney	07/04/2021
1089	Vandewege,Daniele	06/15/2021
1089	Vandewege,Daniele	07/04/2021
1101	Schricker Jr,Jerry	06/15/2021
1101	Schricker Jr,Jerry	07/04/2021
1133	Misiewicz,Stacey	06/15/2021
1133	Misiewicz,Stacey	07/04/2021
1184	Tanis,Wendy	06/15/2021
1184	Tanis,Wendy	07/04/2021
1185	Priebe,Dean	06/15/2021

After:

12114820 YTD Import.xlsx
	A	B	C	D
1	Worker ID	Worker Name	Time Period	Check Date
2	1027	Sorensen,Robert	Check Date - Qtr 2	06/15/2021
3	1027	Sorensen,Robert	Check Date - Qtr 3	07/04/2021
4	1030	Dickinson,Timothy	Check Date - Qtr 2	06/15/2021
5	1030	Dickinson,Timothy	Check Date - Qtr 3	07/04/2021
6	1034	Mooney,Brad	Check Date - Qtr 2	06/15/2021
7	1034	Mooney,Brad	Check Date - Qtr 3	07/04/2021
8	1041	Adams,Kathleen	Check Date - Qtr 2	06/15/2021
9	1041	Adams,Kathleen	Check Date - Qtr 3	07/04/2021
10	1041	Adams,Kathleen	Check Date - Qtr 4	10/01/2021
11	1042	Anderson,Christopher	Check Date - Qtr 2	06/15/2021
12	1042	Anderson,Christopher	Check Date - Qtr 3	07/04/2021
13	1055	Mills-Halso,Susan	Check Date - Qtr 2	06/15/2021
14	1055	Mills-Halso,Susan	Check Date - Qtr 3	07/04/2021
15	1079	McBride,Rodney	Check Date - Qtr 2	06/15/2021
16	1079	McBride,Rodney	Check Date - Qtr 3	07/04/2021
17	1089	Vandewege,Daniele	Check Date - Qtr 2	06/15/2021
18	1089	Vandewege,Daniele	Check Date - Qtr 3	07/04/2021
19	1101	Schricker Jr,Jerry	Check Date - Qtr 2	06/15/2021
20	1101	Schricker Jr,Jerry	Check Date - Qtr 3	07/04/2021
21	1133	Misiewicz,Stacey	Check Date - Qtr 2	06/15/2021
22	1133	Misiewicz,Stacey	Check Date - Qtr 3	07/04/2021
23	1184	Tanis,Wendy	Check Date - Qtr 2	06/15/2021
24	1184	Tanis,Wendy	Check Date - Qtr 3	07/04/2021
25	1185	Priebe,Dean	Check Date - Qtr 2	06/15/2021
Sheet3

Cell Formulas
Range	Formula
C2:C25	C2	="Check Date - Qtr "&ROUNDUP(MONTH(D2)/3,0)

Sub PPP_Time_Period()



Dim sht As Worksheet

Dim lastrow As Long



Set sht = ActiveSheet



lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row



Selection.Insert Shift:=xlToRight

ActiveCell = "Time Period"

ActiveCell.Offset(1, 0).FormulaR1C1 = "=""Check Date - Qtr ""&ROUNDUP(MONTH(RC[1])/3,0)"

ActiveCell.Offset(1, 0).Copy Range(ActiveCell.Offset(1, 0), Cells(lastrow, ActiveCell.Column))

End Sub

 

[DanteAmor]

PERFECT! Thank you for the assist.

I'm glad to help you. Thanks for the feedback.

 

[Serafin54]

I'm glad to help you. Thanks for the feedback.

one small tweak if possible, if not, not the end of the world by any means but is there a code i can put in to tell it if any cells have no date in that range, leave blank.

Flory 6.22.21.xlsx
	A	B	C	D	E	F	G	H
1	ID	Name	Sum of Work	Sum of OT2	Sum of Orientation	Sum of OT1	Time Period
2	2002	Silva, Stephen				0.01	Check Date - Qtr 1	01/01/2020
3	5003	Strickler, Anthony				-0.01	Check Date - Qtr 1	01/02/2021
4	7007	Winfrey, Michael	0.01				Check Date - Qtr 4	12/01/2020
5	12011	Deckert, Christopher				-0.01	Check Date - Qtr 1
6	13002	Walker, Jeremy	-0.01			-0.01	Check Date - Qtr 1
7	13003	Salazar Morales, Jose				0.01	Check Date - Qtr 1
8	15031	Castro, Manuel				-0.01	Check Date - Qtr 1
9	16011	Cunningham, Kenneth				0.01	Check Date - Qtr 1
10	18001	Miller, Donald	-0.01			0.00	Check Date - Qtr 1
11	18013	Capulin, Christopher	0.01				Check Date - Qtr 1
12	19009	Soto, Raul	0.01			0.01	Check Date - Qtr 1
13	19012	Marquez, Edwin				-0.01	Check Date - Qtr 1
14	19017	Fortune, Robert				-0.01	Check Date - Qtr 1
15	19020	Seely, Aaron				0.01	Check Date - Qtr 1
16	19025	Taing, Chhay				-0.01	Check Date - Qtr 1
17	19033	Reed, Evan				-0.01	Check Date - Qtr 1
18	20015	Sughrue, Patrick	-0.01			-0.01	Check Date - Qtr 1
19	20020	Vaccarezza, Blake	-0.01				Check Date - Qtr 1
20	20051	Zuniga, Lino	-16.00				Check Date - Qtr 1
21	20076	Nguyen, Thimson				-0.01	Check Date - Qtr 1
22	20088	Mirabile, Kirk	-0.01			-0.01	Check Date - Qtr 1
23	20107	Wentzell, James				-0.01	Check Date - Qtr 1
24	20144	Bauche, Rusty				0.01	Check Date - Qtr 1
25	20187	Mcdonnell, Paul	-0.01				Check Date - Qtr 1
26	20208	Ferdin, Isaac				0.01	Check Date - Qtr 1
27	20225	Fernandez, Angel				-0.01	Check Date - Qtr 1
28	20236	Moreno Castillo, Ma	0.01				Check Date - Qtr 1
29	20238	Reed, Kevin			-2.00		Check Date - Qtr 1
audit results

 

[DanteAmor]

if any cells have no date in that range, leave blank.

Try this

Sub PPP_Time_Period()
  Dim lastrow As Long
  Dim col As Long
  
  lastrow = Cells(Rows.Count, "A").End(xlUp).Row
  col = ActiveCell.Column
  Selection.Insert Shift:=xlToRight
  ActiveCell = "Time Period"
  
  With Range(Cells(2, col), Cells(lastrow, col))
    .FormulaR1C1 = "=IF(RC[1]="""","""",""Check Date - Qtr ""&ROUNDUP(MONTH(RC[1])/3,0))"
    .Value = .Value
  End With
End Sub

 

[Serafin54]

Try this

Sub PPP_Time_Period()
  Dim lastrow As Long
  Dim col As Long
 
  lastrow = Cells(Rows.Count, "A").End(xlUp).Row
  col = ActiveCell.Column
  Selection.Insert Shift:=xlToRight
  ActiveCell = "Time Period"
 
  With Range(Cells(2, col), Cells(lastrow, col))
    .FormulaR1C1 = "=IF(RC[1]="""","""",""Check Date - Qtr ""&ROUNDUP(MONTH(RC[1])/3,0))"
    .Value = .Value
  End With
End Sub

of course. an if statement. duh. Thank you so very much!

 

[DanteAmor]

Again with pleasure. Thanks for the feedback

 

[Serafin54]

Thank you. My only problem with PQ is that with vba i can create a ribbon tab so that coworkers (most can barely spell Excel) can push a button after some other formatting and scrubbing and achieve what is needed.

But thank you.

Not sure why but all of a sudden i started getting this when using the code. i highlight the date column, run the vba and viola..... lol. Is it something i am doing wrong?

Book1
	J	K
1	#VALUE!	Date
2	Check Date - Qtr 1	01/01/2020
3		10/10/2021
Sheet1

 

[DanteAmor]

lastrow = Cells(Rows.Count, "A").End(xlUp).Row

The macro is based on column A to find the last row with data.
I guess in this process column A is empty.

Change the line to this one and try again:

lastrow =activesheet.cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row

 

[Serafin54]

The macro is based on column A to find the last row with data.
I guess in this process column A is empty.

Change the line to this one and try again:

lastrow =activesheet.cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row

So close i can taste it lol. I'm getting this on the test column i tried. It added the check date below the last row instead of down to the last row. I mean, i can always made a comment that col a needs to be completed if the logic isn't there. not a huge deal.

ck history 7-2-21.xlsx
	L	M
1	Time Period	date
4		01/01/2020
5		12/31/2020
6	Check Date - Qtr 1
Sheet2

 

[DanteAmor]

I did not understand well.
If the macro put the date in cell L6, it means that in some column in row 6 you have a cell with some value, it can be a blank space inside the cell.

I think we have the reference column in view, we just have to invert these lines:

  lastrow = Cells(Rows.Count, "A").End(xlUp).Row
  col = ActiveCell.Column

Try this:

Sub PPP_Time_Period()
  Dim lastrow As Long
  Dim col As Long
  
  col = ActiveCell.Column
  lastrow = Cells(Rows.Count, col).End(xlUp).Row
  Selection.Insert Shift:=xlToRight
  ActiveCell = "Time Period"
  
  With Range(Cells(2, col), Cells(lastrow, col))
    .FormulaR1C1 = "=IF(RC[1]="""","""",""Check Date - Qtr ""&ROUNDUP(MONTH(RC[1])/3,0))"
    .Value = .Value
  End With
End Sub

 

[Serafin54]

I did not understand well.
If the macro put the date in cell L6, it means that in some column in row 6 you have a cell with some value, it can be a blank space inside the cell.

I think we have the reference column in view, we just have to invert these lines:

  lastrow = Cells(Rows.Count, "A").End(xlUp).Row
  col = ActiveCell.Column

Try this:

Sub PPP_Time_Period()
  Dim lastrow As Long
  Dim col As Long
 
  col = ActiveCell.Column
  lastrow = Cells(Rows.Count, col).End(xlUp).Row
  Selection.Insert Shift:=xlToRight
  ActiveCell = "Time Period"
 
  With Range(Cells(2, col), Cells(lastrow, col))
    .FormulaR1C1 = "=IF(RC[1]="""","""",""Check Date - Qtr ""&ROUNDUP(MONTH(RC[1])/3,0))"
    .Value = .Value
  End With
End Sub

Now that there is perfection. So it's just looking for the end of the dates now, is that correct?

I tried a few different messed up scenarios and like a charm it works. you're a beast. thanks!!!!!

check history 7-2-21.3.xlsx
	A	B	C	D	E	F	G	H	I
1	1231			Time Period	Date
2				Check Date - Qtr 1	01/30/2021
3				Check Date - Qtr 1	01/31/2021
4				Check Date - Qtr 1	02/01/2021
5				Check Date - Qtr 1	02/02/2021
6				Check Date - Qtr 1	02/03/2021
7				Check Date - Qtr 1	02/04/2021
8				Check Date - Qtr 1	02/05/2021
9				Check Date - Qtr 1	02/06/2021
10				Check Date - Qtr 1	02/07/2021
11				Check Date - Qtr 1	02/08/2021
12				Check Date - Qtr 1	02/09/2021
13				Check Date - Qtr 1	02/10/2021
14				Check Date - Qtr 1	02/11/2021
15
16
17				Check Date - Qtr 1	02/14/2021
18				Check Date - Qtr 1	02/15/2021
19
20									321
Sheet9