Thread: Macro to change date format and then run function based on greater than or equal to

Hello Libby,

It looks like you need a User Defined Function or UDF for short. A UDF can be used on a Worksheet like a formula. If I understand what you want to do correctly then this UDF should do it. If not, let me know and we'll work on it. The result is returned to the cell that called the UDF.

Code:

Function DetermineDocsDeadline(m As Range) As Variant

  Dim D As Long
    
    If IsDate(m) = True Then
       D = CLng(m)
       If D >= CLng(CDate("19/01/2010")) Then
         DetermineDocsDeadline = CDate((D + 67) - (Weekday(D) + 61))
       End If
    End If
    
End Function

UDF Example

Code:

   'Place this code in a cell
   =DetermineDocsDeadline(H1)

Hello Libby,

I have rewritten the macro. You can either run this using ALT+F8 (Macro Dialog) or by attaching it to a button on the sheet. It assumes the data is on the "Sheet1". It compares the values in column "H" against the deadline in the macro. Once all the dates have been checked, the new dates are copied over to "Sheet2" starting in cell "A1".

Code:

'Written: March 18, 2010
'Author:  Leith Ross

Sub DetermineDeadlines()

  Dim D As Long
  Dim Deadline As Long
  Dim DocDates() As Variant
  Dim DstWks As Worksheet
  Dim Rng As Range
  Dim RngEnd As Range
  Dim SrcWks As Worksheet
    
    Deadline = CLng(CDate("19/01/2010"))
    
    Set SrcWks = Worksheets("Sheet1")
    Set DstWks = Worksheets("Sheet2")
    
    Set Rng = SrcWks.Range("H1")
    Set RngEnd = SrcWks.Cells(Rows.Count, Rng.Column).End(xlUp)
    Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, SrcWks.Range(Rng, RngEnd))
    
    ReDim DocDates(1 To Rng.Rows.Count, 1 To 1)
    DocDates = Rng.Value
    
      For Each Item In DocDates
        If IsDate(Item) = True Then
          D = CLng(Item)
          If D >= Deadline Then
            Item = CDate((D + 67) - (Weekday(D) + 61))
          End If
        End If
      Next Item
      
      DstWks.Cells.ClearContents
    
      Set Rng = DstWks.Range("A1").Resize(UBound(DocDates), 1)
      Rng.Value = DocDates()
      
End Sub