PDA

View Full Version : [SOLVED:] Formulas to values with offset based on date > today



Eville
09-13-2013, 05:50 AM
Dear all,

I'm struggling with a piece of code for a few days now but i cant make it to do what i have in mind. Here is the code:

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
'Turns formula into entered data
Dim TheRng As Range
Dim n As Date
n = Date
For Each cell In Sheets("TF planning").Range("C56:C61")
On Error Resume Next
Set TheRng = Sheets("TF planning").Range("C56:D61").SpecialCells(xlCellTypeConstants, 23)
On Error GoTo 0
If Not TheRng Is Nothing Then
For Each cll In Sheets("TF planning").Range("C51:D61")
If cell.Value < n And cll.Offset(0, 1).HasFormula Then cll.Offset(0, 1).Value = cll.Offset(0, 1).Value
Next cll
End If
Next
End Sub
And this is what i am trying to make it do:

A B C D

56 test
Fr
▌▌Fixed
TEST


57 test
Sa
11-09-2013
LH-PCE


58 test
Su
=C57+1
=D57


59 test
Mo
=C58+1
=D61


60 test
Tu
=C59+1
=D61


61 test
We
▌▌Fixed
LH-PJE-10



The code supposted to check if the date in cell C58, C59, C60 is smaller (less, earlier) then today and if there is a formula in cells D58,D59,D60.
In this example the date in cell C58 is smaller then today, so the formula in cell D58 should turn into values. However the date in cell C59 is equal to today and the cell in C60 is greater then today, so the formulas in D59 and D60 should remain formulas.
At this moment the code as above turns all formulas in D58, D59 and D60 in values ...
Can someone give me a hand here? (i know there are probably more ways to do so, but this is the code i can kinda understand haha thats why i choose this way, i hope it is the right way?)
Thank you very much in advance for the help!

Best regards,

Ev.

SamT
09-13-2013, 07:36 AM
I'm not sure exactly what is going on. If this doesn't fix it, Attach a sample workbook with a few representative rows in it. Underneath those rows, put a couple of values in a couple of cells and use formulas that reference those cells so we don't see any errors.


'
Set TheRng = Sheets("TF planning").Range("C56:D61").SpecialCells(xlCellTypeFormulas)
'
If Not TheRng Is Nothing Then
For Each cll In TheRng
If cll.Offset(0, -1).Value < n Then cll.Value = cll.Value
Next cll
End If

Eville
09-14-2013, 08:34 AM
Thanks a load Sam for the quick reply. At this moment i cant test your code but i hope to give a reply about it on monday. Ill test it and if it doesnt work i will post an example :-))

snb
09-15-2013, 11:11 AM
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
For Each cl In Sheets("TF planning").Range("C56:C61")
if cl.hasformula and cl.Value < date And cl.Offset(, 1).HasFormula Then cl.Offset(, 1).Value = cl.Offset(, 1).Value
Next
End Sub

Avoid reserved names (e.g. cell) for names of variables.
PS. Is Eville Eindhoven ?

Eville
09-16-2013, 05:30 AM
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
For Each cl In Sheets("TF planning").Range("C56:C61")
if cl.hasformula and cl.Value < date And cl.Offset(, 1).HasFormula Then cl.Offset(, 1).Value = cl.Offset(, 1).Value
Next
End Sub

Avoid reserved names (e.g. cell) for names of variables.
PS. Is Eville Eindhoven ?
Hi again,
Thx both for the suggestions. unfortunately both didnt help me :(
The code from SamT refers to the cell in the next column (cll.Offset(0, -1).Value < n) which of course isnt a date because it contains a product name (in the example LH-PCE). Even if i change it to "cll.Value < n" it doesnt work.

The code from snb also didnt work.
Here is an attachment with a piece of the sheet. Idea is to make values from the formulas in cell D58: D60 based on the date. All formulas in these cells before 'today' should turn into values so the data doesnt get lost after a month.
In the VBA i pasted all codes tried so far.

Any other ideas maybe? :help

PS: no, not Eindhoven but Tilburg :p

Edit: Bah i cant add an attachment (getting a grey screen, thats all ><)

Edit 2: uploaded the file on http://www.filedropper.com/testsheet1 (it works for me)

snb
09-16-2013, 08:16 AM
Didn't work can't be described as 'detailed feedback'.
Even if it's from 'de schoonste staad van't laand'.
Please be more specific about what you did and the results you got.

Eville
09-17-2013, 07:53 AM
Didn't work can't be described as 'detailed feedback'.
Even if it's from 'de schoonste staad van't laand'.
Please be more specific about what you did and the results you got.
Haha, it's not the 'schoonste staad' but still nice to live in :rofl:
Anyway i think i messed up when we started with the offset (0,1) and offset (0,-1). Now i have kinda made it working, altho it was a first try to step up towarts the final goal, which is the date in column A, days in column B and the two different production lines in column C and D. Depending on the date in column A i would like to fix the data in columns C and D (everything before 'today').
So far i manage to make this code work and now i try to make make it work for two columns with this code:


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
'Turns formula into entered data
Set TheRng = Sheets("TF planning").Range("A56:D61").SpecialCells(xlCellTypeFormulas)
For Each cll In TheRng
If cll.Offset(0, -2).Value < Date Then cll.Value = cll.Value
If cll.Offset(0, -3).Value < Date Then cll.Value = cll.Value
Next cll
End Sub

This is the final result; before running the code i have the excel sheet that looks like:


A
14/09/2013

B
Vr

C
▌▌Fixed

D
TEST



15/09/2013

Za

=C56

=D56



16/09/2013

Zo

=C56

=D56



17/09/2013

Ma

=C56

=D61



18/09/2013

Di

=C56

=D61




When i switch tabs (run the code) i get "runtime error (1004): Application-defined or object-defined error" and the second line ("If cll.Offset(0, -3).Value < Date Then cll.Value = cll.Value") gets highlighted when i press the debug button.
However most of the formulas are now turned into values. This makes the sheet look like this:


A
14/09/2013

B
Vr

C
▌▌Fixed

D
TEST



15/09/2013

Za

▌▌Fixed

TEST



16/09/2013

Zo

▌▌Fixed

=D56



17/09/2013

Ma

=C56

=D61



18/09/2013

Di

=C56

=D61




Which makes me wonder: why do i get the error (probably some wrong programming my side haha) and why does the code still kinda work?
I still cant add attachments but i tried to upload the testfile again here:
http://www.filedropper.com/testsheet2

When switching tabs again the last cell also changes from =D56 to TEST (again with the errors of course).
I hope this info is enough for further trouble shooting solving? :thumb

SamT
09-17-2013, 12:36 PM
TheRng includes Columns C & D. When you checked the Offset(0, -3) from Column C, there is no column "A-1"

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
'Turns formula into entered data
Set TheRng = Sheets("TF planning").Range("A63:D65").SpecialCells(xlCellTypeFormulas)
For Each cll In TheRng
If Range("A" & cll.Row).Value < Date Then cll.Value = cll.Value
Next cll
End Sub

Eville
09-18-2013, 05:16 AM
TheRng includes Columns C & D. When you checked the Offset(0, -3) from Column C, there is no column "A-1"

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
'Turns formula into entered data
Set TheRng = Sheets("TF planning").Range("A63:D65").SpecialCells(xlCellTypeFormulas)
For Each cll In TheRng
If Range("A" & cll.Row).Value < Date Then cll.Value = cll.Value
Next cll
End Sub


Dear SamT,

Your code kinda works: it does change formulas to values, however it changes ALL formulas to values (even if the date is later then today) and after i switch back to the original sheet i get a runtime error '1004': no cells where found. I tested also if i change the < Date into =Date and that works: It only changes the current date formulas to values. When i change = Date to <= Date the code works the same as before: it changes all formulas to values and gives the runtime error.
My guess is the code only needs a small adjustment but i dont know which button to press :(

Any suggestions to help me collegues out, pretty please?

snb
09-18-2013, 05:55 AM
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
For Each cl In Range("C56:C61").SpecialCells(xlCellTypeFormulas)
If cl.offset(-2).Value < Date Then cl.resize(,2).Value = cl.resize(,2).Value
Next
End Sub

PS. You need capitals to describe yourself : I instead of i.

Eville
09-18-2013, 07:45 AM
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
For Each cl In Range("C56:C61").SpecialCells(xlCellTypeFormulas)
If cl.offset(-2).Value < Date Then cl.resize(,2).Value = cl.resize(,2).Value
Next
End Sub

PS. You need capitals to describe yourself : I instead of i.
Dear snb,

Thank you for your help. I am one step closer to a solution (I think): the code works after a small adjustment and now looks like this:

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
For Each cl In Range("A56:D61").SpecialCells(xlCellTypeFormulas)
If cl.Offset(, -2).Value < Date Then cl.Resize(, 2).Value = cl.Resize(, 2).Value
Next
End Sub

However I still get the runtime error '1004': no cells where found. So the code itself works but the error isnt very neat. The code is placed in ThisWorkbook ofcourse.
Pretty funny btw how different codes can lead to the same result. Can you explain in short what the 'cl.Resize(, 2).Value' does please?

PS: thanks for the correction, I always forget to write it in caps ><

SamT
09-18-2013, 09:02 AM
Once I had made sure that the cells in TheRng had formulas in them, both snb's and mine worked fine on your example file.

The sheet had been tested such that the cells in TheRng no longer met the Sub's criteria.


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
'Turns formula into entered data
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next

Set TheRng = Sheets("TF planning").Range("A1:D" & LastRow).SpecialCells(xlCellTypeFormulas)
If TheRng Is Nothing Then
MsgBox "No Formulas Cells Found"
Exit Sub
End If
For Each cll In TheRng
If Range("A" & cll.Row) < Date Then cll.Value = cll.Value
Next cll
End Sub

Try this one too.

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
'Turns formula into entered data
Set StartCell = Range("C1")
Set LastCell = Range("A:A").Find(Date).Offset(-1, 3)

On Error Resume Next
Application.DisplayAlerts = False
Range(StartCell, LastCell).Value = Range(StartCell, LastCell).Value
Application.DisplayAlerts = True
End Sub

snb
09-18-2013, 09:21 AM
If no cells in the indicated range contain a formula the code raises an error.


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
on error resume next
For Each cl In Range("C56:C61").SpecialCells(xlCellTypeFormulas)
If cl.offset(-2).Value < Date Then cl.resize(,2).Value = cl.resize(,2).Value
Next
End Sub

Don't be shy and dive into the Excel VBEditor's helpfiles lemma 'resize'.

Eville
09-19-2013, 01:04 AM
Thank you both SamT and snb for all suggested options!
I tried all 3 codes; SamT's first code works great without the msgbox as it keeps popping the box even if there are formulas so i removed that 4 lines. The second option gives a runtime error 91: Object variable or With block variable not set. However the code does the job :)
The code from snb is the one im using since its short and (for me) understandable, too bad i couldnt come up with the on error resume next idea.
I will change the status of this thread to solved, thanks again for all the help!