Solved Macro to memorize dates in a column

Microsoft Excel 2010 - complete product...
March 9, 2018 at 01:16:54
Specs: Windows 7, 2,4 GHz / 4 GB
Hello,

Assuming I have an excel file in which I want to complete a year's deliveries that are made on a daily basis. I will take a simple example:
- assume column A has 5000 rows completed with formula =TODAY()
- assume column B is blank now, but at the end of today, it will have 50 cells completed

I want to create a macro to memorize the dates of today in A for all the rows I completed in B.
So I must look if value in B is <> than "", then copy column A and paste values only onto column A.

I know I'm doing something wrong and even though I tried to step through, I can't figure out how to copy/paste column A onto itself and keep values for the not-blank cells in column B.

Here's the macro I tried, among others:

Sub Memoreaza_Data()
Dim LastRow As Long
Dim c As Range

Application.ScreenUpdating = False

With ActiveSheet
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row

For Each c In ActiveSheet.Range("B:B" & LastRow)
If c.Value <> "" Then

Range("A:A" & LastRow).Copy
Range("A:A" & LastRow).PasteSpecial xlPasteValues
End If
Next

End With
Application.ScreenUpdating = True
End Sub

It's not pasting anything, column A still has the =TODAY() formula even if B has text in it.

Also if I delete a row in column B (I made a mistake), even if it pasted the value (date), it should add the formula back, because there is no more data in column B.

message edited by Mrrrr


See More: Macro to memorize dates in a column

Reply ↓  Report •

#1
March 9, 2018 at 09:54:30
✔ Best Answer
re: "It's not pasting anything, column A still has the =TODAY() formula even if B has text in it."

I'm surprised that you are saying that it's not pasting anything instead of saying "It's producing an error on this line":

For Each c In ActiveSheet.Range("B:B" & LastRow)

You should be getting an error on that line (I sure do) because this part of the syntax is incorrect:

"B:B" & LastRow

"B:B" refers to the entire column, so VBA doesn't know what to do with the & LastRow part.

It should be "B1:B" & LastRow so that VBA con resolve that to be something like "B1:B56".

You use the same syntax here, but the code never gets this far because of the previous error.

Range("A:A" & LastRow).Copy
Range("A:A" & LastRow).PasteSpecial xlPasteValues

Besides, even if you syntax was correct, that method doesn't make any sense. What you are telling VBA to do is the Copy/Paste Values to the entire Column A range every time something is found in Column B. You are not referring to the corresponding cell, in column A, you are referring to the entire range. If your code ever made it past the For Each C instruction, you would lose all of your =TODAY() formulas the first time there was a value in Column B.

The following code fixes both the syntax errors and refers to the individual Column A cells, not the entire Column A range. Note the use of c.Row. The code also eliminates the Copy/Paste operations by simply replacing the formula with the value.

Sub Memoreaza_Data()
Dim LastRow As Long
Dim c As Range

 Application.ScreenUpdating = False

  With ActiveSheet
     LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
      
'Replace Formula with Value if B <> ""
     
     For Each c In .Range("B1:B" & LastRow)
       If c.Value <> "" Then
         .Range("A" & c.Row) = .Range("A" & c.Row).Value
       End If
     Next

  End With
 
 Application.ScreenUpdating = True
End Sub

As far as your "deletion" issue, I'm not quite sure what you asking for. You said:

"Also if I delete a row in column B (I made a mistake), even if it pasted the value (date), it should add the formula back, because there is no more data in column B."

Deleting "a row in column B" is very different that deleting the value in a cell in Column B. is that what you meant? e.g. deleting the value in B6, not deleting B6 itself.

Assuming that is what you meant, then this Worksheet_Change macro should address all of your requirements. This code will run automatically each time you make a change to the sheet.

The code monitors the sheet and if a change is made to Column 2 (B), it will either replace the TODAY function with the Value or replace the Value with the TODAY function, depending on what was done in column B. If you have any questions about how the code works, just let me know.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
Dim c As Range

On Error GoTo CleanExit

'Determine if change was made to Column B
   If Target.Column = 2 Then
    Application.EnableEvents = False

'Loop through range, changing Column A as appropriate.
       For Each c In Range(Target.Address)
         If c = "" Then
           Range("A" & c.Row).Formula = "=TODAY()"
         Else: Range("A" & c.Row) = Range("A" & c.Row).Value
         End If
       Next
     'End If
    
CleanExit:
    Application.EnableEvents = True
    
   End If
End Sub


How To Post Data or Code ---> Click Here Before Posting Data or VBA Code


Reply ↓  Report •

#2
March 9, 2018 at 11:31:57
Wow, this is great! More than I had hoped for. The second macro works a treat!

Yes, when I said remove the row in column B I meant the values in the B cell, not the entire row. Why I said "row" was because column B is just the 2nd column of a bigger table, and I used the wrong words.

Thank you very much, yet again, for your help and for the explanations.

Off topic:
I also made the color swatches you told me about in another of my posts and now I'm exploring the right click context menu. Thanks again for that, it really improved my productivity!


Reply ↓  Report •
Related Solutions


Ask Question