I am creating a spreadsheet and would like to have rows drop off automatically at a certain age. Is there a way to do this?
My company submits engineering requests to our NY office, and I have created a job tracker to monitor the time from submittal to receipt of plans. My boss would like it if I can figure out how to make the data rows drop off after a certain time period. I've gotten all the formulas in for day counts and auto-updating with addition of new jobs, but I don't know how to go about this task.
Thank you for any input!
Something like the code below should do the trick. In this example I am starting from row two and checking a date in column F to see if this is greater than the defined interval days old (21 here), you can change the initialisation of these variables as you require:
Sub delete_old()
Dim rowDate
Dim curDate
Dim interval
Dim curAdd
Dim vCell As Range
' set interval to an appropriate no of days
interval = 21 ' can be more precise e.g. for 5 mins: (1 / 24) / 12
curDate = Now()
' assuming we want to start from row 2 and that date is in column F
Set vCell = Range("F2")
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(vCell)
curAdd = vCell.Address
If curDate - vCell.Value >= interval Then
vCell.EntireRow.Delete
Set vCell = Range(curAdd)
Else
Set vCell = Range(curAdd).Offset(1, 0) ' next row
End If
Loop
Set vCell = Nothing
End Sub
You will need to call this automatically upon an event such as saving or opening the workbook. Let me know if you need assistance setting this up or any clarifications on the code above.
Related
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
I am working on a project in Excel:
First of all I have a cell with a value that changes every day.
Everyday when this cell changes I want it to report on what the value was that day with its corresponding date.
Therefore I have created 2 rows = Date and value
And I want it to create new columns for each time the value of the cell changes.
So E.G. today the value of the cell is 10
This will then create a new column with todays date and 10 as the value.
Tomorrow the value of the cell is 12.
This will then create a new column with the date of tomorrow and 12 as the value.
So it will a historical timeframe where I can look back at the value for each day.
Also I cant predict the future value of the cell so it has to create a new columns based on the current value that is shown each day.
Thanks in advance :)
Tried looking at youtube videoes and searching on google for similar problems but without any luck.
Try to insert this code into the Worksheets Code:
Option Explicit
Private Sub Worksheet_Change(ByVal rngTarget As Range)
Dim rngValue As Range: Set rngValue = Me.Range("B2")
Dim rngDateValue As Range: Set rngDateValue = rngValue.Offset(-1, 0).Resize(2, 1)
Dim rngNew As Range: Set rngNew = rngDateValue.Offset(0, 1)
If Not Intersect(rngTarget, rngValue) Is Nothing Then
rngNew.Insert xlShiftToRight, xlFormatFromLeftOrAbove
Set rngNew = rngDateValue.Offset(0, 1) ' Restore modification caused by Insert
rngNew.Value = rngDateValue.Value
End If
End Sub
I assumed the value you want to save is in B2, and the corresponding date above it, as seen on this picture:
I am attempting to learn some vba programming for excel, Long story short
I have a machine using an allen bradley plc, I have created a program in the plc to record hourly run statitistics, I have managed to get these to update live into an excel sheet, it uploads each hour for 24 hours. The machine runs on 3 shifts 6am to 2pm, 2pm to 10 pm, 10 pm to 6 am. In the factory we class each day as 6am to 6am.
I have written the following code, which copies the values from the plc and pastes them to the matching date, cell "c10" contains =today() then on sheet 2 it will paste the values to a calender under the matching date.
this is now working fine however i would like to change it so that under each date it contains 6am to 6 am values rather than 24 hours worth.
the issue i have is that cell c10 (todays date) will update after 12am and therefore the paste destination will change.
heres my code
Private Sub work_test()
'set variables
Dim Day As Date
Dim rfound As Range
Dim frow, fcol As Integer
Dim sh1, sh2 As Worksheet
'set sheets
Set sh1 = Sheets("sheet1")
Set sh2 = Sheets("sheet2")
'sets day as current day, finds matching day in sheet2
Day = sh1.Range("c10")
Set rfound = sh2.Range("7:11").Find(Day, LookIn:=xlValues)
If Not rfound Is Nothing Then
frow = rfound.Row
fcol = rfound.Column
sh1.Range("c11:c34").Copy sh2.Cells(9, fcol)
Else
MsgBox "No match found"
End If
'runs timer
Call timer
End Sub
Sub timer()
'repeats cell update timer
Application.OnTime Now + TimeValue("00:01:00"), "work_test"
End Sub
Hope someone can help, not looking for a complete solution, just a bit of help in the correct direction
Thanks
These are two of many ways achieving what yo want:
1.- Replace formula in C10 with this one:
= TODAY() + IF( NOW() - TODAY() < TIME(6,0,0) , -1 , 0 )
Formula above validates the time and it less that 06:00:00 then rest one to the date. Thus anything between midnight and 06 AM will be taken as the day before
2.- In your code replace this line:
Day = sh1.Range("c10")
with this:
Day = Date + IIf(Time < TimeSerial(6, 0, 0), -1, 0)
Same as in point 1 above, only that since you are using VBA there is no need to have the date as a formula in the worksheet, the date of the machine can be obtain that directly in the VBA and proceed from there.
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
I have an Excel report that generates everyday that have dates that differ from anywhere to three days to two due to the uneven amount of calendar days in any given month. The report, in column F looks like this below. Today's date is 07/16/13 and the process generating the report is configured to show anything greater then 180 days so that we catch the right data.
01/12/2014
01/15/2014
01/15/2014
01/12/2014
01/15/2014
I'd like to delete all rows that are not equal to 1/15/14. I don't know if there is a way to add another column with just 1/15 and then delete the rest? Any help or direction would be greatly appreciated.
We are now going into the file everyday and doing a sort by date and then delete. I'd like to automate it.
Thank you
Use a loop to iterate through the rows and remove if less than your criteria. I referenced this thread for row deletion code: Delete a row in Excel VBA.
I'm assuming your dates are in Column A and start at Row 1.
Private Sub Remove_Rows()
Dim CutoffDate As Date
CutoffDate = Date + 180
Dim ws As Worksheet
Set ws = ActiveSheet
Dim RowCounter As Integer
RowCounter = 1
Do While ws.Cells(RowCounter, 1) <> ""
If ws.Cells(RowCounter, 1) < CutoffDate Then
ws.Rows(RowCounter).Delete
End If
RowCounter = RowCounter + 1
Loop
End Sub