best way to select column based on current date (Excel VBA) - excel

I have a small tracker program I am building in Excel VBA. I have a userform that I keep up throughout the day, inputting my tasks/data via an 'Add' button. At the end of the day, I click the 'Post' button, and it saves the data to my worksheets where appropriate.
Thought I had it finished and working correctly, but now apparently my sub to select the correct column based on the day's date is not working, and I'm not sure why, as it had been working perfectly throughout development.
This piece is vital, as my other functions to post the day's data rely on this. I've read a lot of other posts about how to do this (selecting a column based on current date), but none have explained why mine isn't working. Trying to become a better coder, and not just a copy/paste coder, so thought I would try asking here. Copy/Paste usually gets me into these messes, where I'm using tools/functions that work, but I don't know why, and can't troubleshoot/debug on my own.
My total project involves 5 worksheets, but this sub should only involve 2 of them. "Tasks" and "Data Tracker", both of which have a row of dates.
Below is the sub in question.
Public Sub currentDate()
'sub to assign current date to global values
Set rng - Range("H2:HZ2")
Set myDate = rng.Find(What:=Int(Date), LookIn:=xlFormulas)
End Sub
If I step through it, Date is pulling the correct date, and xlFormulas shows a value of -4123 (I don't even know if that matters)..
(UPDATE) so apparently, this morning, it decided to work perfectly. facepalm Any clues?
(UPDATE) so, per usual, I try adding features as I fix something else, so this took a bit more researching to solve, but #Super-Symmetry pointed me in the right direction! As noted in a comment down below, I changed my date headers in the two sheets to be more of a "start date + n" situation. Although his suggestion of using xlValue instead of xlFormula was on the right track, Find. was still having trouble with date vs serial. Ultimately this is what I got to work:
Public Sub currentDate()
'sub to assign current date to global values
'load the date range
Set rng = Worksheets("Tasks").Range("H2:HZ2")
'load the values in the range
dateArray = Range("H2:HZ2").Value
Dim day As Variant 'object to load dateArray
Dim loc As Integer 'matches date with cell location
'converting the date to serial
For Each day In dateArray
day = CLng(day)
loc = loc + 1
If day = Date Then 'we found the right column
Set myDate = rng(loc)
'selects the correct cell
If ActiveSheet.name = "Data Tracker" Then 'adjust the row
Cells(myDate.Row + 3, myDate.Column).Select
Else 'sheet must be Tasks
Cells(myDate.Row + 2, myDate.Column).Select
End If
Exit Sub
End If
Next
End Sub
It's not elegant, but it works.. please feel free to educate me if you have any cleaner ways to do this!

Try changing Int(Date) to CLng(Date)
Public Sub currentDate()
'sub to assign current date to global values
Dim rng As Range, myDate As Range
Set rng = Range("H2:HZ2")
Set myDate = rng.Find(What:=CLng(Date), LookIn:=xlValues)
End Sub

Related

Getting Excel to Copy Data From One Cell to Another Depending on Date

Apologies in advance as this is my first time posting something on this site and am not the best at explain issues.
I have a spread sheet, this has production data such as meters daily, meters monthly etc. These values are updated by adding TAGS from a PLC using Rockwell VantagePoint Excel add-in (if your unfamiliar with this it shouldn't matter this part is not what I am struggling with)
I need I way to copy data from one cell to another cell on the same sheet at month end. Basically the Meters monthly field needs to copied into another cell at the end of the month to record meters run for that month. The monthly meters run resets back to 0 at the end of the month.
Basically I need to copy the value in J7 into the corresponding month in W column at the end of that month. If it could ignore the year that would be advantageous as I don't need it to keep the old values and would mean I just need one column.
I have some experience at MS-Excel, also VBA but mainly in MS-Access never in MS-Excel. If answers could be explained as simply and hands on as possible it would be appreciated.
After Googling the issue I came across this formula and changed the ranges to fit my sheet but Excel doesn't like it saying it contains an error
=QUERY( A1:B6; "select B where A =date """&TEXT(TODAY();"yyyy-mm-dd")&""" "; 0
Sorry again if I haven't explained myself properly.
If your workbook isn't guaranteed to be open at the end of each month I would update the value every time it gets opened, like(Should be placed in ThisWorkbook):
'Runs when you open the workbook
Private Sub Workbook_Open()
'Loops through U3 to the last used cell in that column
For Each c In Range(Cells(3, 21), Cells(Rows.Count, 21).End(xlUp))
'Applies the J7 value to the current month and exits the sub
If Month(c) = Month(Now) Then c.Offset(, 2).Value = [J7]: Exit Sub
Next c
End Sub
Also, not that it matters but, I would apply the following formula in U3:U14 to always get the correct dates:
=EOMONTH(DATE(YEAR(TODAY()),ROW()-2,15),0)
Okay, I'm still not super sure what the question is and I know more Access VBA than Excel VBA, but here's something that might help to find a solution.
You can make a check date function that returns a Boolean value:
Public Function EoMonthCheck() As Boolean
Dim eo_month As Date, today As Date
eo_month = Format(WorksheetFunction.EoMonth(Now(), 0), "yyyy-MM-dd")
today = Format(Now(), "yyyy-MM-dd")
If today = eo_month Then
EoMonthCheck = True
Else
EoMonthCheck = False
End If
End Function
And the,, to add a value to the "W" column, we might use something like this:
Public Function AppendValue(Optional target_cell As String = "J7")
''' This could be a subroutine, too, I guess, since we're not returning anything.
Dim i As Integer
''' Activate whatever sheet you want to work with
Worksheets("Sheet1").Activate
If EoMonthCheck() = True Then
''' Look up the bottom of the 'W' column and find the first non-empty cell
''' Add 1 to that cell to get you to the next cell (the first empty one).
i = Cells(Rows.Count, "W").End(xlUp).Row + 1
''' Set the value of that empty cell in the 'W' column to the value of 'J7'
''' which will happen after we evaluate whether it is the end of the month.
Cells(i, "W").Value = Range(target_cell).Value
End If
Then, you could maybe trigger that each time the workbook opens.

Calculate age ONLY if DOB is present

I have a large file that I am working on and need to be able to calculate people DOB. I have attached a sample file here to get an idea.... but basically what I am looking to do is ONLY if data exists in the "DOB" column, for "Age" to be calculated.
DOB will be listed in every other column for up to 18 different people (so column A, C, E.....) In columns B, D, F..... I am looking to have the age be calculated in years.
The catch is, there will NOT always be data for 18 people, so this is something that would only need to calculate IF data is present in the DOB column.
Ideally this would be a macro that I would run when I open the file so that all of the ages can update.
How do I even go about doing something like this?
I would expect output to just show age in years.... so if DOB was 01/01/2001 - age would show as 18
I'm going to make the assumption that VBA is overkill. This worked for me ...
=IF(A1="","",ROUNDDOWN(YEARFRAC(A1,NOW()),0))
If you were looking at a VBA solution, the above formula is translatable directly to VBA. It's not complete in relation to your context but that's a bigger piece that is hard to inject into without seeing your code at present ...
Public Sub WriteAgeToCell()
If Range("A1").Text <> "" Then
Range("A2") = WorksheetFunction.RoundDown(WorksheetFunction.YearFrac(Range("A1"), Now), 0)
End If
End Sub
Using Workbook_Open() in your Workbook object can be used to automatically recalculate what you need.
So to put it all together, and with a little bit of compromise, you can do the following ...
Private Sub Workbook_Open()
Dim objSheet As Worksheet, lngAgeCol As Long, lngEndRow As Long, i As Long
Dim lngStartRow As Long
With Range("rngHeaderAge")
Set objSheet = .Worksheet
lngAgeCol = .Column
lngStartRow = .Row + 1
End With
lngEndRow = objSheet.Cells.SpecialCells(xlLastCell).Row
For i = lngStartRow To lngEndRow
objSheet.Cells(i, lngAgeCol).FormulaR1C1 = "=IF(RC[-1]="""","""",ROUNDDOWN(YEARFRAC(RC[-1],NOW()),0))"
Next
End Sub
When the workbook is opened, it will fill down the formula from the row below the header column and then if DOB's are changed during the session, the age will update on the fly.
To make the above work, all you need to do is update the code into the Workbook object within the VBA editor and create a named range against the header for the age column, as shown below.

Pivot Table Date Filter Issue (Not a valid date)

I have a requirement to filter an existing pivot table (PivotTable1 in 'Pivot' worksheet) in a workbook based on dates input by the user in another worksheet (Control). I should add that the cells in the control sheet have data validation on them to force dates only in the cells. The code I have so far is this:
Sub FilterPivotfromCell()
Dim Invoice_Start_Date As Date
Dim Invoice_End_Date As Date
Invoice_Start_Date = CDate(Worksheets("Control").Cells(3, "E").Value)
Invoice_End_Date = CDate(Worksheets("Control").Cells(3, "G").Value)
Sheets("Pivot").Select
MsgBox IsDate(Invoice_End_Date)
MsgBox IsDate(Invoice_Start_Date)
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable1").PivotFields("Date").ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("Date").PivotFilters.Add _
Type:=xlDateBetween, Value1:=Invoice_Start_Date, Value2:=Invoice_End_Date
End Sub
When stepping through the code using F8, and with watches on the variables Invoice_Start_Date and Invoice_End_Date, everything points to the variables being dates (type shows as date in the watch window, and the isdate message boxes come back as 'True' in both instances. However, when running the macro, as soon as it comes to the part where the pivot table is filtered, I get the message 'Run-time error '1004': The date you entered is not a valid date. Please try again.'
I wonder if the issue is something to do with having UK regional settings as I know I've had issues in the past with this.
Also, to clarify, cell contents of E3 is 01/10/2016 and cell contents of G3 is 31/10/2016.
Edit: I've tried following the suggestion here, but it had made no difference. The source of my pivot table does include blank rows also, but I've tried limiting it to just the data and it has made no difference.
Edit 2: Well, wouldn't you know it. A little more googling and came up with the solution here. Basically adding clng format around the dates in the pivot filter has done the trick?
Here is the revised working code, following the answer provided by #MP24 in this question.
Sub FilterPivotfromCell()
Dim Invoice_Start_Date As Date
Dim Invoice_End_Date As Date
Invoice_Start_Date = CDate(Worksheets("Control").Cells(3, "E").Value)
Invoice_End_Date = CDate(Worksheets("Control").Cells(3, "G").Value)
Sheets("Pivot").Select
MsgBox IsDate(Invoice_End_Date)
MsgBox IsDate(Invoice_Start_Date)
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable1").PivotFields("Date").ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("Date").PivotFilters.Add _
Type:=xlDateBetween, Value1:=CLng(Invoice_Start_Date), Value2:=CLng(Invoice_End_Date)
End Sub
The work around for this problem is we should clear all filters applied to the field before filtering so that all filters are cleared for that field.
like this...
set pf = pt.pivotfields("FilmReleaseDate")
pf.clearallfilters

excel vba range.find not finding date

I'm trying to establish the minimum date and its associated row for later use in a subroutine.
I'm hitting an error and i've spent the last few hours isolating the issue and searching for the solution to no avail.
I have a spreadsheet where column B contains a range of dates arranged in order. I can find the minimum date (the message box correctly returns 11/14/2015), but when I try use that date value to identify the row number I get error 91. Here is my code:
Sub testing()
ThisWorkbook.Worksheets("Burn Curve Data").Activate
Dim rDateColumn As Range
Dim dMinDate As Date
Set rDateColumn = ActiveSheet.Range("B:B")
dMinDate = Application.WorksheetFunction.Min(rDateColumn)
MsgBox dMinDate
Dim rMinCell As Range
Dim intMinRow As Integer
Set rMinCell = rDateColumn.Find(dMinDate, LookIn:=xlValues, LookAt:=xlWhole)
intMinRow = rMinCell.Row
MsgBox intMinRow
End Sub
I tried inserting an If Not statement after Set rMinCell and determined that range.find is not finding the date. Here is the statement I used to identify the error, but I deleted it to clean up the code for this posting.
If Not rMinCell is Nothing Then
intMinRow = rMinCell.Row
Else
MsgBox "error finding rMinCell"
End If
I also tried re-saving dMinDate into a string then using that string in the range.find but I encountered the same error of not finding the date.
Another nuance that may or may not be relevant is that this data exists within a named range on the worksheet. What am I doing wrong with my range.find line?!?
As discussed in the comments it appears the issue arises when the column is formatted as something other than Date.
To do this via code you can add this line after you set the rDateColumn variable:
rDateColumn.NumberFormat = "m/d/yyyy"
This should format the column as a date and your Find method should work appropriately.
Alternatively you can select the column, click 'Format Cells' and then ensure 'Date' is selected under Category.

Entering Dates in Excel based off parameters using VBA

So, right now I have this excel sheet where there is a last revision date. I have named this column "LastRevisionDate". And then I have a column named "RevisionFrequency" . The "RevisionFrequency" contains a drop-down menu consisting of terms, "Annually", "Bi-Annually"(2 times in a year), "Semi-Annually", and "Quarterly". And then I have a column where it states the "NextRevisionDate". So I want to create a VBA code that would calculate the NextRevisionDate from the LastRevisionDate and the RevisionFrequency.
For example. Say in column "A" i have the RevisionFrequency to be "Bi-annually" And the last revision date was Mar-14 in column "B", then I would want the NextRevisionDate in column "C" to state Mar,Sep .Thats basically saying that the item gets revised twice a year. So I would want to create a macro where Column "C" is based off the RevisionFrequency and LastRevisionDate. I realize I could do this with a formula, but I have new items being added constantly so I do not want to keep copying formulas into each cell. Also for some items, they do not need revision, I would also like to have a blank cell if there is no LastRevisionDate.
So far, I have this updated code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = Sheets(1)
If Not Intersect(Target, ws.Range("LastCalDate").Value) Is Nothing Then
Dim Lastdate As Date
Dim DueDate As Variant
Dim Frequency As String
Dim R As Variant
Dim C As Variant
Dim R1 As Variant
Dim C1 As Variant
Dim R2 As Variant
Dim C2 As Variant
R = Range("LastCalDate").Row
C = Range("LastCalDate").Column
R1 = Range("CalDueDate").Row
C1 = Range("CalDueDate").Column
R2 = Range("CalFrequency").Row
C2 = Range("CalFrequency").Column
Lastdate = Cells(R, C).Value 'Last Cal Date
DueDate = Cells(R1, C1).Value 'Cal Due Date
Frequency = Cells(R2, C2)
If Frequency = "Annually" Then
DueDate = DateAdd("mmm", 12, Lastdate)
End If
If Frequency = "Semi-Annually" Then
DueDate = DateAdd("mmm", 6, Lastdate)
End If
If Frequency = "Quarterly" Then
DueDate = DateAdd("mmm", 3, Lastdate)
End If
End Sub
“Am I just overcomplicating my code?”
That is the wrong question. The first question is not “What can I do?” but “What do my users want?”
If you start by saying “I can produce wooden clogs”, you may never learn they want soft slippers. You may not be able to produce soft slippers but you can probably produce something a lot better than wooden clogs if know it is required. Start with the design of the ideal product then cut it down to what is practical.
From your description, I visualise something like this:
You may have many other columns and these three columns may be in different positions; it does not matter, we will restrict ourselves these columns for now.
It sounds to me as though you have two requirements and an issue:
You have a worksheet where the values in the Next Revision Date column may be unreliable or missing. You require a macro that will run down the existing worksheet and enter correct values into the Next Revision Date column.
You have a requirement to set the values in the Next Revision Date column automatically as new rows are added of existing Revision Frequencies and Last Revision Dates are amended. This could be achieved by running macro 1 or using the Worksheet Change event, as you suggest. There may be other approaches but I will not address this requirement.
If you look at the last three rows of my example worksheet, you will notice the day of the month in the Next Revision Date column is not the same as that in the Last Revision Date. This is because I converted the value in the Frequency column to 3, 6 or 12 and added that number of months to the Last Revision Date. In the last three rows the new month does not have as many days as the old and the VBA function has, for example, converted 30 February to 2 March. Is this the effect you require? I have included code to bring the date back to the “correct” month. Often the most difficult task in macro design is identifying all these exceptions and specifying how they are to be handled.
I will only consider macro 1 first since you can use it for both requirements while you are design and implementing macro 2. If you run into problems with macro 2, ask a new question. You can ask as many questions as you like – providing they are good questions – but they should only be one issue per question.
You need a macro that will step down every row of the worksheet. If you are using an online tutorial or you have bought a book on Excel VBA, you may find a suitable example there. If you are using neither an online tutorial nor a book, please start. It will not take long to master the basics of Excel VBA and the time spent learning the basics will quickly repay itself. Trying to search the web for code when you do not know the basics is very difficult.
If your tutorial/book does not tell you how to step down every row of the worksheet, try searching SO for “[excel-vba] find last row of worksheet”. There are lots of variations of this question so you should have no difficulty in finding something suitable. You do not have to do so on this occasion because I show you how below but I believe this is the best way of using this site. Break your requirement down into little steps and then search for a question relevant to each step.
Below is a simple macro 1. Study my code and come back with questions if necessary. However, the more you can understand on your own, the faster you will develop.
Welcome to the joys of programming.
Option Explicit
' Using constants for values that may change makes your code easier to
' understand and easier to maintain.
Const ColFrequency As Long = 1
Const ColLastRevisionDate As Long = 2
Const ColNextRevisionDate As Long = 3
Const RowDataFirst As Long = 2
Sub FixNextRevisionDate()
Dim DateLastCrnt As Date
Dim DateNextCrnt As Date
Dim NumMonthsToStep As Long
Dim RowCrnt As Long
Dim RowLast As Long
' Replace "Data" with the name of your worksheet
With Worksheets("Data")
' This is the most popular method of finding the last row but it will
' not work in every situation. I believe it is appropriate for your
' current requirement but suggest you look for questions that describe
' other methods and which explain why they might be better.
RowLast = .Cells(Rows.Count, ColFrequency).End(xlUp).Row
For RowCrnt = RowDataFirst To RowLast
' Convert Frequency to 3, 6 or 12
' I have used the LCase function to allow for inconsistent use of
' upper and lower case
Select Case LCase(.Cells(RowCrnt, ColFrequency).Value)
Case "annually"
NumMonthsToStep = 12
Case "bi-annually"
NumMonthsToStep = 6
Case "semi-annually"
NumMonthsToStep = 6
Case "quarterly"
NumMonthsToStep = 3
Case Else
' Unknown frequency. never assume the worksheet is correct
' if an error will cause your macro to fail.
' This is an easy way to highlight faulty values for user
' attention.
With .Cells(RowCrnt, ColFrequency)
.Interior.Color = RGB(255, 0, 0)
NumMonthsToStep = 0
End With
End Select
If NumMonthsToStep <> 0 Then
' Had valid frequency
If IsDate(.Cells(RowCrnt, ColLastRevisionDate).Value) Then
' Value in Last Revision Date column is a date
DateLastCrnt = .Cells(RowCrnt, ColLastRevisionDate).Value
' Calculate next date by adding NumMonthsToStep
DateNextCrnt = DateSerial(Year(DateLastCrnt), _
Month(DateLastCrnt) + NumMonthsToStep, _
Day(DateLastCrnt))
' You may not want this but it shows how to do it if you do
If Day(DateNextCrnt) < Day(DateLastCrnt) Then
DateNextCrnt = DateSerial(Year(DateNextCrnt), _
Month(DateNextCrnt), _
0)
End If
With .Cells(RowCrnt, ColNextRevisionDate)
.Value = DateNextCrnt
' Replace with date format of your choice
.NumberFormat = "d mmm yy"
End With
Else
' The Last Revision Date is not a date
With .Cells(RowCrnt, ColLastRevisionDate)
.Interior.Color = RGB(255, 0, 0)
End With
End If
End If
Next
End With
End Sub

Resources