Quarter from date in another column

Serafin54

Board Regular
Joined
Apr 11, 2014
Messages
58
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 IDWorker NameCheck Date
1027Sorensen,Robert06/15/2021
1027Sorensen,Robert07/04/2021
1030Dickinson,Timothy06/15/2021
1030Dickinson,Timothy07/04/2021
1034Mooney,Brad 06/15/2021
1034Mooney,Brad 07/04/2021
1041Adams,Kathleen06/15/2021
1041Adams,Kathleen07/04/2021
1041Adams,Kathleen10/01/2021
1042Anderson,Christopher06/15/2021
1042Anderson,Christopher07/04/2021
1055Mills-Halso,Susan06/15/2021
1055Mills-Halso,Susan07/04/2021
1079McBride,Rodney06/15/2021
1079McBride,Rodney07/04/2021
1089Vandewege,Daniele06/15/2021
1089Vandewege,Daniele07/04/2021
1101Schricker Jr,Jerry06/15/2021
1101Schricker Jr,Jerry07/04/2021
1133Misiewicz,Stacey06/15/2021
1133Misiewicz,Stacey07/04/2021
1184Tanis,Wendy 06/15/2021
1184Tanis,Wendy 07/04/2021
1185Priebe,Dean06/15/2021


After:
12114820 YTD Import.xlsx
ABCD
1Worker IDWorker NameTime PeriodCheck Date
21027Sorensen,RobertCheck Date - Qtr 206/15/2021
31027Sorensen,RobertCheck Date - Qtr 307/04/2021
41030Dickinson,TimothyCheck Date - Qtr 206/15/2021
51030Dickinson,TimothyCheck Date - Qtr 307/04/2021
61034Mooney,Brad Check Date - Qtr 206/15/2021
71034Mooney,Brad Check Date - Qtr 307/04/2021
81041Adams,KathleenCheck Date - Qtr 206/15/2021
91041Adams,KathleenCheck Date - Qtr 307/04/2021
101041Adams,KathleenCheck Date - Qtr 410/01/2021
111042Anderson,ChristopherCheck Date - Qtr 206/15/2021
121042Anderson,ChristopherCheck Date - Qtr 307/04/2021
131055Mills-Halso,SusanCheck Date - Qtr 206/15/2021
141055Mills-Halso,SusanCheck Date - Qtr 307/04/2021
151079McBride,RodneyCheck Date - Qtr 206/15/2021
161079McBride,RodneyCheck Date - Qtr 307/04/2021
171089Vandewege,DanieleCheck Date - Qtr 206/15/2021
181089Vandewege,DanieleCheck Date - Qtr 307/04/2021
191101Schricker Jr,JerryCheck Date - Qtr 206/15/2021
201101Schricker Jr,JerryCheck Date - Qtr 307/04/2021
211133Misiewicz,StaceyCheck Date - Qtr 206/15/2021
221133Misiewicz,StaceyCheck Date - Qtr 307/04/2021
231184Tanis,Wendy Check Date - Qtr 206/15/2021
241184Tanis,Wendy Check Date - Qtr 307/04/2021
251185Priebe,DeanCheck Date - Qtr 206/15/2021
Sheet3
Cell Formulas
RangeFormula
C2:C25C2="Check Date - Qtr "&ROUNDUP(MONTH(D2)/3,0)


VBA Code:
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
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Serafin54

Board Regular
Joined
Apr 11, 2014
Messages
58
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
ABCDEFGH
1IDNameSum of WorkSum of OT2Sum of OrientationSum of OT1Time Period
22002Silva, Stephen0.01Check Date - Qtr 101/01/2020
35003Strickler, Anthony-0.01Check Date - Qtr 101/02/2021
47007Winfrey, Michael0.01Check Date - Qtr 412/01/2020
512011Deckert, Christopher-0.01Check Date - Qtr 1
613002Walker, Jeremy-0.01-0.01Check Date - Qtr 1
713003Salazar Morales, Jose0.01Check Date - Qtr 1
815031Castro, Manuel-0.01Check Date - Qtr 1
916011Cunningham, Kenneth0.01Check Date - Qtr 1
1018001Miller, Donald-0.010.00Check Date - Qtr 1
1118013Capulin, Christopher0.01Check Date - Qtr 1
1219009Soto, Raul0.010.01Check Date - Qtr 1
1319012Marquez, Edwin-0.01Check Date - Qtr 1
1419017Fortune, Robert-0.01Check Date - Qtr 1
1519020Seely, Aaron0.01Check Date - Qtr 1
1619025Taing, Chhay-0.01Check Date - Qtr 1
1719033Reed, Evan-0.01Check Date - Qtr 1
1820015Sughrue, Patrick-0.01-0.01Check Date - Qtr 1
1920020Vaccarezza, Blake-0.01Check Date - Qtr 1
2020051Zuniga, Lino-16.00Check Date - Qtr 1
2120076Nguyen, Thimson-0.01Check Date - Qtr 1
2220088Mirabile, Kirk-0.01-0.01Check Date - Qtr 1
2320107Wentzell, James-0.01Check Date - Qtr 1
2420144Bauche, Rusty0.01Check Date - Qtr 1
2520187Mcdonnell, Paul-0.01Check Date - Qtr 1
2620208Ferdin, Isaac0.01Check Date - Qtr 1
2720225Fernandez, Angel-0.01Check Date - Qtr 1
2820236Moreno Castillo, Ma0.01Check Date - Qtr 1
2920238Reed, Kevin-2.00Check Date - Qtr 1
audit results
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,571
Office Version
  1. 2007
Platform
  1. Windows
if any cells have no date in that range, leave blank.

Try this

VBA Code:
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

Board Regular
Joined
Apr 11, 2014
Messages
58
Try this

VBA Code:
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

Well-known Member
Joined
Dec 3, 2018
Messages
13,571
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

Again with pleasure. Thanks for the feedback
 

Serafin54

Board Regular
Joined
Apr 11, 2014
Messages
58
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
JK
1#VALUE!Date
2Check Date - Qtr 101/01/2020
310/10/2021
Sheet1
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,571
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

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:

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

Serafin54

Board Regular
Joined
Apr 11, 2014
Messages
58
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:

VBA Code:
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
LM
1Time Perioddate
401/01/2020
512/31/2020
6Check Date - Qtr 1
Sheet2
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,571
Office Version
  1. 2007
Platform
  1. Windows
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:

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

Try this:
VBA Code:
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
 
Solution

Serafin54

Board Regular
Joined
Apr 11, 2014
Messages
58
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:

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

Try this:
VBA Code:
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
ABCDEFGHI
11231Time PeriodDate
2Check Date - Qtr 101/30/2021
3Check Date - Qtr 101/31/2021
4Check Date - Qtr 102/01/2021
5Check Date - Qtr 102/02/2021
6Check Date - Qtr 102/03/2021
7Check Date - Qtr 102/04/2021
8Check Date - Qtr 102/05/2021
9Check Date - Qtr 102/06/2021
10Check Date - Qtr 102/07/2021
11Check Date - Qtr 102/08/2021
12Check Date - Qtr 102/09/2021
13Check Date - Qtr 102/10/2021
14Check Date - Qtr 102/11/2021
15
16
17Check Date - Qtr 102/14/2021
18Check Date - Qtr 102/15/2021
19
20321
Sheet9
 

Forum statistics

Threads
1,141,062
Messages
5,704,060
Members
421,325
Latest member
tapete86

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top