How to move cells based on date

[Fronik]

Hello,

I've been investigating this for a long time with no results, so maybe someone here can help me?
I have sheet1, where i have columns D9:E61, on D columns i have some info and on E columns i have date (dd.mm.yyy).

I need a button that checks if there is dates like tooday+1 (tomorrow) and if found, same row D column value to be moved to column A last row and column E date to be removed? Anybody can help with this?

 

[Kaper]

Open VBA editor (Alt+F11), insert new module (in VBEditor Insert->Module) and in a module window paste such VBA code:

Sub ForFronik()
Dim cell As Range, tomorrow As Date
tomorrow = Date + 1
Do
  Set cell = Range("E9:E61").Find(what:=tomorrow, lookat:=xlWhole, LookIn:=xlValues)
  If Not cell Is Nothing Then
    Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = cell.Offset(0, -1).Value
    cell.Offset(0, -1).Resize(1, 2).Delete Shift:=xlUp
  End If
Loop Until cell Is Nothing
End Sub

Then insert a button and associate this macro with it.

PS. File have to be saved as macro-enabled workbook (like xlsm or xlsb)

 

[Fronik]

Open VBA editor (Alt+F11), insert new module (in VBEditor Insert->Module) and in a module window paste such VBA code:

Sub ForFronik()
Dim cell As Range, tomorrow As Date
tomorrow = Date + 1
Do
  Set cell = Range("E9:E61").Find(what:=tomorrow, lookat:=xlWhole, LookIn:=xlValues)
  If Not cell Is Nothing Then
    Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = cell.Offset(0, -1).Value
    cell.Offset(0, -1).Resize(1, 2).Delete Shift:=xlUp
  End If
Loop Until cell Is Nothing
End Sub

Then insert a button and associate this macro with it.

PS. File have to be saved as macro-enabled workbook (like xlsm or xlsb)

View attachment 115131

Did so, but when i click the button, nothing happens
Worksheet is macro enabled and there is macros in use, but now i can't understand why does nothing happen?

 

[My Aswer Is This]

Did you do this?
"Then insert a button and associate this macro with it."

Show us the code you put in the button

 

[Fronik]

Open VBA editor (Alt+F11), insert new module (in VBEditor Insert->Module) and in a module window paste such VBA code:

Sub ForFronik()
Dim cell As Range, tomorrow As Date
tomorrow = Date + 1
Do
  Set cell = Range("E9:E61").Find(what:=tomorrow, lookat:=xlWhole, LookIn:=xlValues)
  If Not cell Is Nothing Then
    Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = cell.Offset(0, -1).Value
    cell.Offset(0, -1).Resize(1, 2).Delete Shift:=xlUp
  End If
Loop Until cell Is Nothing
End Sub

Then insert a button and associate this macro with it.

PS. File have to be saved as macro-enabled workbook (like xlsm or xlsb)

View attachment 115131

Hello,

I got it work! Me cells were just formatted wrongly so that was the problem So thank you so much, you are an angel!

 

[Fronik]

One more thing, i used to format cells as "Short Date" to get it work, and now when it removes rows, there will be new rows without formatting. Could it be possible any way to make vba to format columns correctly when clicking the button before it runs code mentioned before? I tried to use Range("A1").NumberFormat = "m/d/yyyy", put code you wrote to me, doesn't regognize those cells as short date then.

 

[Kaper]

To make macro more tollerant to different date formats change searching in VAlues into searching in Formulas, so:

  Set cell = Range("E9:E61").Find(what:=tomorrow, lookat:=xlWhole, LookIn:=xlFormulas)

as for formatting new cells - I don't think you want to format cell A1. Rather Exxx, where xxx is a row below last row with data in column E. Let's make it with "some extra space" and format 10 rows below last filled in. I assumed that under last row with data there is nothing in column E. No summary, no texts, no side calculations - just empty cells in column E below last date.

The whole code could look like:

Sub ForFronik()
Dim cell As Range, tomorrow As Date
tomorrow = Date + 1
Do
  Set cell = Range("E9:E61").Find(what:=tomorrow, lookat:=xlWhole, LookIn:=xlFormulas)
  If Not cell Is Nothing Then
    Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = cell.Offset(0, -1).Value
    cell.Offset(0, -1).Resize(1, 2).Delete Shift:=xlUp
  End If
Loop Until cell Is Nothing
Cells(Rows.Count, "E").End(xlUp).Offset(1, 0).Resize(10, 1).NumberFormat = "m/d/yyyy"
End Sub