Previous Topic Next Topic

Copying dates to another worksheet.

Solved/Closed
Scencea - Updated on Aug 14, 2017 at 06:29 AM
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 - Aug 17, 2017 at 11:02 PM
Hello,

I found this script from vcoolio, thanks for that! 

Sub Advise()

      Dim x As Integer
      Dim lRow As Long
lRow = Range("E" & Rows.Count).End(xlUp).Row

For Each cell In Range("E2:E" & lRow)
x = cell.Row
     r1 = Range("A" & x) 'Location
     r2 = Range("B" & x) 'Maintenance Task
     r3 = Range("E" & x) 'Notification Due Date
If cell = [today()] Then
MsgBox "NOTIFICATIONS ARE DUE TO BE SENT TODAY!" & vbNewLine & "Location : " & r1 & vbNewLine & "Maintenance Task: " & r2 & _
 vbNewLine & "Notification Due Date: " & r3, vbExclamation, "WARNING!"
     End If
Next
Advise2
End Sub


Sub Advise2()

      Dim I As Integer
      Dim lRow As Long
lRow = Range("E" & Rows.Count).End(xlUp).Row

For I = 2 To lRow

     r1 = Cells(i, 1) 'Location
     r2 = Cells(i, 2) 'Maintenance Task
     r3 = Cells(i, 4) 'Maintenance Due Date
     
If Cells(i, 5) >= [today()] And Cells(i, 6) = "" Then

MsgBox "NOTIFICATIONS ARE OVERDUE!" & vbNewLine & "Location : " & r1 & vbNewLine & "Maintenance Task: " & r2 & _
 vbNewLine & "Maintenance Due Date: " & r3, vbExclamation, "WARNING!"
 
End If
Next i

End Sub


Is there an easy possibility to copy the dates the message box gives out into another Worksheet?

Cheers

Scencea

6 responses

Answer 1 / 6
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 262
Aug 14, 2017 at 06:29 AM
Hello Scencea,

If you just want the "Notification Due Date" and the "Maintenance Due Date" from each message box that appears, then the code modified a little as follows may do the task for you:- 


Sub Advise()

      Dim x As Integer
      Dim lRow As Long
lRow = Range("E" & Rows.Count).End(xlUp).Row

For Each cell In Range("E2:E" & lRow)
x = cell.Row
     r1 = Range("A" & x) 'Location
     r2 = Range("B" & x) 'Maintenance Task
     r3 = Range("E" & x) 'Notification Due Date
If cell = [today()] Then
MsgBox "NOTIFICATIONS ARE DUE TO BE SENT TODAY!" & vbNewLine & "Location : " & r1 & vbNewLine & "Maintenance Task: " & r2 & _
 vbNewLine & "Notification Due Date: " & r3, vbExclamation, "WARNING!"
Range("E" & x).Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
     End If
Next

Advise2

End Sub


Sub Advise2()

      Dim i As Integer
      Dim lRow As Long
lRow = Range("E" & Rows.Count).End(xlUp).Row

For i = 2 To lRow

     r1 = Cells(i, 1) 'Location
     r2 = Cells(i, 2) 'Maintenance Task
     r3 = Cells(i, 4) 'Maintenance Due Date
     
If Cells(i, 5) >= [today()] And Cells(i, 6) = "" Then

MsgBox "NOTIFICATIONS ARE OVERDUE!" & vbNewLine & "Location : " & r1 & vbNewLine & "Maintenance Task: " & r2 & _
 vbNewLine & "Maintenance Due Date: " & r3, vbExclamation, "WARNING!"
Cells(i, 4).Copy Sheet2.Range("B" & Rows.Count).End(3)(2)
       End If
Next i

End Sub


The additional lines of code are lines 16 and 42. The dates are copied over to sheet2, Column A for the "Notification Due Dates" and sheet2, Column B for the "Maintenance Due Date".

I hope that this helps.

Cheerio,
vcoolio.
1
Scencea Posts 6 Registration date Monday August 14, 2017 Status Member Last seen August 18, 2017
Aug 14, 2017 at 08:18 AM
Hey vcoolio,

unfortunately I don't get it to work properly. I'm just really new to vba and there is a long way to go. Here is my current code (Propably you'll just shake your head when you see it :D)

So at the Advise Sub it checks if something needs to be done in the next 7 days and in the Advise 2 Sub it checks if something is overdue.

It would be awesome if I could just copy the whole row (column A-I) to a new worksheet. 

Sub Advise()

      Dim x As Integer
      Dim lRow As Long
      Dim sh As Worksheet
      
    Set sh = Sheets("Tabelle1")
    
lRow = Range("F" & Rows.Count).End(xlUp).Row

For Each cell In Range("F2:F" & lRow)
x = cell.Row
     r1 = Range("B" & x) 'Location
     r2 = Range("C" & x) 'Maintenance Task
     r3 = Range("F" & x) 'Maintenance Due Date
If cell.Value <= Date + 7 And cell.Value >= Date And cell.Value <> “” Then



MsgBox "NOTIFICATIONS ARE DUE TO BE SENT TODAY!" & vbNewLine & "Location : " & r1 & vbNewLine & "Maintenance Task: " & r2 & _
 vbNewLine & "Notification Due Date: " & r3, vbExclamation, "WARNING!"

     End If
Next
End Sub


Sub Advise2()

      Dim x As Integer
      Dim lRow As Long

lRow = Range("F" & Rows.Count).End(xlUp).Row

For Each cell In Range("F2:F" & lRow)
x = cell.Row
     r1 = Range("B" & x) 'Location
     r2 = Range("C" & x) 'Maintenance Task
     r3 = Range("F" & x) 'Maintenance Due Date
If cell.Value < Date And cell.Value >= Date - 300 And cell.Value <> “” Then

MsgBox "NOTIFICATIONS ARE DUE TO BE SENT TODAY!" & vbNewLine & "Location : " & r1 & vbNewLine & "Maintenance Task: " & r2 & _
 vbNewLine & "Notification Due Date: " & r3, vbExclamation, "WARNING!"

     End If
Next
End Sub


Thanks for your help and patience.

Cheers

Scencea
0
Answer 2 / 6
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 262
Aug 14, 2017 at 08:48 AM
Hello Scencea,

You've declared a worksheet variable and set a value to that variable but you haven't used it (not that this will make a difference in this case).

If you intend to use both subroutines ( Advise and Advise2) as one then you will need to call Advise2() from Advise(). Have a look at line 20 in the code in my post #1. So, just to see if this works for you, place:- 
Advise2

just after 

Next
(line 25)

in your code in post #2. Test the code again (in a copy of your work book).

However, I have a feeling that your situation is a little different from the original purpose of the code and that you may not actually need both codes to do the task for you. Hence, upload a sample of your work book to a free file sharing site, such as Drop Box, and then post the link to your file back here.
Please use dummy data. Please also give a clear explanation of what you intend (inputs and expected results).

I'll have a look at what can be done once I see your sample.

Thanks Scencea.

Cheerio,
vcoolio.
1
Answer 3 / 6
Scencea Posts 6 Registration date Monday August 14, 2017 Status Member Last seen August 18, 2017
Aug 14, 2017 at 09:39 AM
https://onedrive.live.com/redir?resid=D013BBEEDC77DE5!19584&authkey=!AFP-hh0nJGiF9JM&ithint=file%2cxlsx

There you go. =)

The first button (Advise) tells you what Task has to be done within the next month.

The second button (Advise2) tells you which task is overdue.

I'd like to copy these tasks (the complete row) into the "ws2" starting from line 7 to get a better overview.

I hope things are now clearer.

Cheers

Scencea
0
Answer 4 / 6
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 262
Aug 14, 2017 at 11:53 PM
Hello Scencea,

I've moved your PM here to your thread. Being a public forum every post needs to be kept public for the benefit of anyone who may come by here in future looking for a similar solution to yours. They cannot be resolved privately. I'll look into why your posts have been deleted and advise. 


https://1drv.ms/x/s!AuV9x-2-OwENgZkAU_6GHSckaIX0kw

The first button (Advise) tells you what Task has to be done within the next month.

The second button (Advise2) tells you which task is overdue.

I'd like to copy these tasks (the complete row) into the "ws2" starting from line 7 to get a better overview.

I hope things are now clearer.

Cheers


Anyway, based on the comment you placed in the sample, and based on my understanding of that comment, I've written a different code for you as follows (you won't need the other two codes):- 

Sub DetermineTasks()

Application.ScreenUpdating = False

With Tabelle1.[A5].CurrentRegion
        .AutoFilter 4, 1
        .Offset(1).EntireRow.Copy
        Tabelle2.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
        '.Offset(1).EntireRow.Delete
        .AutoFilter
    End With
   
Tabelle2.Range("A2", Tabelle2.Range("H" & Tabelle2.Rows.Count).End(xlUp)).Sort Tabelle2.[E2], 1
Tabelle2.Columns.AutoFit

Application.CutCopyMode = False
Application.ScreenUpdating = True

Tabelle2.Select

End Sub


It is based on the monthly time interval in Column D. The code will filter Column D (Tabelle1) for any interval of 1 and then transfer the relevant row of data to Tabelle2. Once in Tabelle2, the code will sort the data for you by date. The code will also delete, if you wish, the "used" data in Tabelle1. If you would like the "used" data deleted then just remove the apostrophe(') from in front of line 9 in the code above (the line in green font).

Following is the link to your sample with the code implemented:-

http://ge.tt/8D9weAm2

Click on the "RUN" button to see it work.

I hope that this helps.

Cheerio,
vcoolio.
0
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 262
Aug 15, 2017 at 06:55 AM
Hello Scencea,

I've restored one of your previous attempts (post #7) and just deleted the other ones as they are duplicates.

Apparently our "robot" which takes care of spam is a little over zealous with certain words related to spam and cannot distinguish between these certain words (which generally appear in any post).

Anyway, you should now be able to post as per normal.

Cheerio,
vcoolio.
0
Scencea Posts 6 Registration date Monday August 14, 2017 Status Member Last seen August 18, 2017
Aug 15, 2017 at 10:08 AM
Hey vcoolio,

thank you very much! =) This is almost perfect.

But I want to Filter by the next Date (Column F) + 30 or maybe 7 Days, would that be possible?

I'm sorry if I was misleading.

Cheers Scencea
0
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 262 > Scencea Posts 6 Registration date Monday August 14, 2017 Status Member Last seen August 18, 2017
Aug 16, 2017 at 04:30 AM
Hello Scencea,

Do you actually wish to sort or filter by Column F?
Just reading your comment in the sample again has me a little confused.

Cheerio,
vcoolio.
0
Scencea Posts 6 Registration date Monday August 14, 2017 Status Member Last seen August 18, 2017
Aug 16, 2017 at 05:14 AM
Hey vcoolio,

sorry for confusing you, and thanks for your patience!

I'll just start over and try to explain it again.

Column D Tells me in which time intervall a task has to be done e.g. 1-24 months. (constant)

Column E shows me when the task was done the last time. (changes to actual date when task was done again)

Column F tells me when a Task has to be done again. -> Column E+D

So the script should have a look at Column F and find alle the tasks that have to be done within the next 14 days for example.

Than it should copy these tasks to a new Workingsheet and sort them by the date they have to be done. (today -> 14days). So that you can just print an overview on what has to be done.


I am now working with conditional formatting and a recorded Macro that just sorts the dates on ws1. This works too, but isn't as elegant :D

I hope it's all clear now, if not just aks ;)

Cheers
Scencea
0

Didn't find the answer you are looking for?

Ask a question
Answer 5 / 6
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 262
Aug 16, 2017 at 07:44 AM
Hello Scencea,

Lets use the DateDif function to help out on this.

In this case, I've used Column I as a temporary helper column into which I've temporarily inserted the following formula:- 
=IF(F6<TODAY(),"""",DATEDIF(TODAY(),F6,""D""))


This will give us the number of days between today and when the next maintenance is due.

Hence, added to my previous code, the modified code will look like this:- 


Sub DetermineTasks()

Dim lr As Long

Application.ScreenUpdating = False

lr = Tabelle1.Range("F" & Rows.Count).End(xlUp).Row

Tabelle1.Range("I6:I" & lr) = "=IF(F6<TODAY(),"""",DATEDIF(TODAY(),F6,""D""))"

With Tabelle1.[A5].CurrentRegion
        .AutoFilter 9, "<=14"
        .Offset(1).EntireRow.Copy
        Tabelle2.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
        '.Offset(1).EntireRow.Delete
        .AutoFilter
    End With
   
Tabelle2.Range("A2", Tabelle2.Range("I" & Tabelle2.Rows.Count).End(xlUp)).Sort Tabelle2.[I2], 1
Tabelle2.Columns.AutoFit

Application.CutCopyMode = False
Application.ScreenUpdating = True

Tabelle1.Columns(9).ClearContents
Tabelle2.Select

End Sub


Hence, the code will determine which tasks are due now and within fourteen (14) days and then transfer the relevant rows of data to Tabelle2. In Tabelle2, I've added Column I to show the number of days remaining (within the fourteen days) until the next maintenance task is due.

Column I in Tabelle1 is then cleared.

Here is the link to the updated sample:-

http://ge.tt/7MsYbBm2

I hope this helps.

Cheerio,
vcoolio.
0
Scencea Posts 6 Registration date Monday August 14, 2017 Status Member Last seen August 18, 2017
Aug 17, 2017 at 05:44 PM
Hey vcoolio,

that's it, I love it. Thank you so much!

Cheers

Scencea
0
Answer 6 / 6
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 262
Aug 17, 2017 at 11:02 PM
Hello Scencea,

You're welcome. I'm glad that I was able to help.

Cheerio,
vcoolio.
0

Similar discussions

encryption message several time in chat
measking -
HelpiOS -

1 response
How to specify macro for current active sheet
seo5906 -
Dave -

18 responses
IF statements with dates and criteria
jimbabama -
Mazzaropi -

3 responses
blank white page for website
yadaves -
ac3mark -

1 response
using web browser page loads but screen blank
inchoate -
leo -

16 responses