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

Kieske

New Member
Joined
Jan 22, 2013
Messages
26
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:


AB
7/28/2013"Formula"
7/30/2013"Formula"

<TBODY>
</TBODY>


AB
7/28/2013"Value"
7/30/2013"Formula"

<TBODY>
</TBODY>
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,977
Office Version
  1. 2016
Platform
  1. Windows
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...

Code:
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

New Member
Joined
Jan 22, 2013
Messages
26
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

New Member
Joined
Jan 22, 2013
Messages
26
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

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,977
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

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...

Code:
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

New Member
Joined
Jan 22, 2013
Messages
26
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

New Member
Joined
Oct 26, 2010
Messages
7
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

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,977
Office Version
  1. 2016
Platform
  1. Windows
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...

Rich (BB code):
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
 

Watch MrExcel Video

Forum statistics

Threads
1,129,795
Messages
5,638,372
Members
417,023
Latest member
Zimbo38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top