VBA: IF Date <= TODAY() replace formula with Value

[Kieske]

Hi,

I've been trying to figure out a VBA that will Loop through a range of Cells in A1:A37 which contains various Dates. I'm trying to check if the date is Less than or equal to the current date. If it is, then the Cell next to in Column B which contains a formula producing a number will remove the formula and replace with Value calculated. Any Help will be appreciated.

Ex:

A	B
7/28/2013	"Formula"
7/30/2013	"Formula"

<TBODY>
</TBODY>

A	B
7/28/2013	"Value"
7/30/2013	"Formula"

<TBODY>
</TBODY>

 

[Rick Rothstein]

Hi,

I've been trying to figure out a VBA that will Loop through a range of Cells in A1:A37 which contains various Dates. I'm trying to check if the date is Less than or equal to the current date. If it is, then the Cell next to in Column B which contains a formula producing a number will remove the formula and replace with Value calculated. Any Help will be appreciated.

Give this macro a try...

Sub MakeValuesIfLessThanOrEqualToToday()
  Dim R As Long
  For R = 1 To 37
    If Cells(R, "A").Value <= Date Then Cells(R, "B").Value = Cells(R, "B").Value
  Next
End Sub

 

[Kieske]

Thanks, I saw similar codes online that related to Date Validation, but all were resulting different sets of criteria. I had a feeling most of this was going to be simple I just didn't know how to put the code together. Thanks again for the help it works like a champ!

 

[Kieske]

Ok I used this macro and it works great, but now I'm finding I need to do the same thing for multiple columns based off the date from column A. So far B:N need changed. I figured out how to do this by using an IF statement for each column but it severely slows the macro down. Is there a way to use one IF statement for for changeing columns B through N using the same Macro?

 

[Rick Rothstein]

Ok I used this macro and it works great, but now I'm finding I need to do the same thing for multiple columns based off the date from column A. So far B:N need changed. I figured out how to do this by using an IF statement for each column but it severely slows the macro down. Is there a way to use one IF statement for for changeing columns B through N using the same Macro?

See if this macro works for you...

Sub MakeValuesIfLessThanOrEqualToToday()
  Dim R As Long
  Application.ScreenUpdating = False
  For R = 1 To 37
    If Cells(R, "A").Value <= Date Then Cells(R, "B").Resize(,13).Value = Cells(R, "B").Resize(,13).Value
  Next
  Application.ScreenUpdating = True
End Sub

 

[Kieske]

Wow that does the trick, I don't think I've ever seen the .Resize() used before. That's a new one on me. Thank you very much, you've been a big help. When I tried all the IF statements in my original way it took at least 3 minutes to execute completely.

 

[SiChambo]

Wow that does the trick, I don't think I've ever seen the .Resize() used before. That's a new one on me. Thank you very much, you've been a big help. When I tried all the IF statements in my original way it took at least 3 minutes to execute completely.

This is great and exactly what I was looking for, however my Range is not 37, rather 1000. My workbook is already 30Mbs with lots of code, so when I run this for just 37 Rows it takes well over 1 minute, could you suggest how I might be able to speed this up, I am literally looking in the active work sheet in column c for todays date (or less) and pasting the value in column J (which is the name of the rostered employee).

The roster changes through the month, therefore I have 12 sheets for months and I want the user to only save changes that have already happened, using this code - which it does - the formula in Column J is the predicted 4 week roster cycle throughout the year, which as always is subject to change.

Many thanks in advance

 

[Rick Rothstein]

This is great and exactly what I was looking for, however my Range is not 37, rather 1000. My workbook is already 30Mbs with lots of code, so when I run this for just 37 Rows it takes well over 1 minute, could you suggest how I might be able to speed this up, I am literally looking in the active work sheet in column c for todays date (or less) and pasting the value in column J (which is the name of the rostered employee).

The roster changes through the month, therefore I have 12 sheets for months and I want the user to only save changes that have already happened, using this code - which it does - the formula in Column J is the predicted 4 week roster cycle throughout the year, which as always is subject to change.

Apparently, you only need to turn Column J's formula to a value when the date in Column C is less than the current date, meaning you do not need the Resize portion of my code, so I change my originally posted code to reflect these differences (you can add the Resize portion back if I am mistaken about it). As for the speed problem, I think (can't be sure though) that turing several things off before the main code and then back on again afterwards might help some (the new code that I added for speedup purposes is shown in blue). Give the following a try and let us know...

Sub MakeValuesIfLessThanOrEqualToToday()
  Dim R As Long
  Dim CalcState As Long
  Dim ScreenUpdateState As Boolean
  Dim StatusBarState As Boolean
  Dim EventsState As Boolean
  
  ' Save the current state of Excel settings.
  ScreenUpdateState = Application.ScreenUpdating
  StatusBarState = Application.DisplayStatusBar
  CalcState = Application.Calculation
  EventsState = Application.EnableEvents
  
  ' Turn off Excel functionality to improve performance.
  Application.ScreenUpdating = False
  Application.DisplayStatusBar = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False
  
  For R = 1 To 37
    If Cells(R, "C").Value <= Date Then Cells(R, "J").Value = Cells(R, "J").Value
  Next
  
  ' Restore Excel settings to original state.
  Application.ScreenUpdating = ScreenUpdateState
  Application.DisplayStatusBar = StatusBarState
  Application.Calculation = CalcState
  Application.EnableEvents = EventsState
End Sub