0

I'm making a work registration list for myself and my colleagues.  In this workbook I created, we have a certain amount of free days we can use, but we need to use those free days before a certain date.  If we don't use them, they will pass away.  So I need to create a code that will automatically delete those free days if they don't get used up before the deadline. but this also needs to happen on opening the file and on multiple sheets So, for example:

I have an cell A1 where 240:00 hours stands in, I want to use a second cell A2 with an date that is one year and 180 days later, and if there is still a value left in cell A1 that it will changed to 0:00.

I need it to work on different cells and also with different times, because some free days will pass after one year and 180 days, and some free days after 5 years.

I know to put code in VBA and create macro's, but i don't know how to write code for VBA, only ajust it a little bit

wouter
  • 1

1 Answers1

1

I hope you realize that cells (and the formulas and functions they contain) cannot modify other cells.  Cells can display misleading values; e.g., you could have a non-zero value stored in the worksheet, but display it as “0” or blank.  VBA can modify cells.

From your description of the situation, I assume that you want to actually delete the “free days” values, and so you want VBA.

You say you want this to work on multiple cells at once, but you don’t say how they are designated.  I assumed that it was OK to hard-code a list of cells in the VBA source.  If you need some other approach, please edit your question to specify it.

Create the following VBA routine.  Use How do I add VBA in MS Office? for reference if you need to.  Change the cell_list value to list the cells that contain “free days” values.

Sub auto_delete()
    Dim cell_list, this_cell As String
    Dim i As Integer
    Dim today_date As Date
today_date = Date
cell_list = "A1,B1"
For i = 0 To UBound(Split(cell_list, ","))
    this_cell = Split(cell_list, ",")(i)
    On Error Resume Next
    If Range(this_cell) Is Nothing Then
        MsgBox this_cell + " is not a valid cell designation."
        Exit For
    End If
    On Error GoTo 0
    If Range(this_cell).Count <> 1 Then
        MsgBox this_cell + " appears to be a range.  Please specify individual cells only."
        Exit For
    End If
    If Range(this_cell).Cells(2, 1).Value < today_date Then
        ' in the past
        Range(this_cell).Cells(1, 1).Value = ""
    End If
Next

End Sub

Notes:

  • Setting cell_list to a comma-separated string is a somewhat klugy way of specifying a list of values.  But apparently my version of VBA is old and out-of-date; I tried cleaner (more modern?) techniques, and they didn’t work.
  • Split(cell_list, ",") does what it looks like — it splits the cell_list into component words, using comma as a separator, and creates an array of values.
  • UBound(Split(cell_list, ",")) gives the highest (upper bound) index into the array.  (This is one less than the number of values, because the indices start at 0.)
  • For i = 0 To (the_above) loops through the values in the array.
  • Split(cell_list, ",")(i) indexes into the array and returns the ith value.
  • I needed to use On Error Resume Next and On Error GoTo 0 to test for invalid cell references; I’m not sure why.
  • Range(this_cell).Cells(2, 1).Value refers to the cell below the current one.  For example, if this_cell is A1, then this refers to A2, where the expiration date is.

I believe that the rest is self-explanatory.

Before:

Spreadsheet: A1 has 16, A2 has 1-Jul-2021, B1 has 42, B2 has 1-Nov-2021

After:

same as above except A1 is blank

Invoke the above routine manually or automatically; whichever is more appropriate for your needs.