VBA - If range value = "date" then

Ill give it a go. I think im making headway as ive got the filtering side down now I used the recorded and it gave me this back:

Code: 
Sub Macro2()
'
' Macro2 Macro
'
'
    Columns("M:M").Select
    Selection.AutoFilter
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
        "31.01.2019"
    Range("B26:I67").Select
    Selection.Copy
    Sheets("March").Select
    ActiveSheet.Paste
End Sub

Not all there but it makes more sense to me now and I think I can work with it.

;)
 
I believe you can replace
Code: 
Range("B26:I67").Select
with
Code: 
Cells.Select
as that has only selected what was applicable at that time. That will likely not be the same tomorrow.
 
You were right :D
I simply used the Cells.Select after filtering to move all the info that I needed. Will be no problem replicating it for every month of the year now and getting it to run on start up.

A long walk for a short drink of water, but thanks for your patience, still building my knowledge of VBA but you've been a massive help.
 
The macro recorder is your friend. :D
 
Me again, i'm now attempting to refine the code for use in a spread sheet that covers every month of the year. I Know it is not the most elegant way or the quickest way but at this stage i'm just trying to get it to work.

Here is what I came up with so far:

Code: 
Private Sub Workbook_Open()
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.03.2019"
    Cells.Select
    Selection.Copy
    Sheets("March").Select
    Range("A1").Select
    ActiveSheet.Paste
    
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.04.2019"
    Cells.Select
    Selection.Copy
    Sheets("April").Select
    Range("A1").Select
    ActiveSheet.Paste
    
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.05.2019"
    Cells.Select
    Selection.Copy
    Sheets("May").Select
    Range("A1").Select
    ActiveSheet.Paste
    
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.06.2019"
    Cells.Select
    Selection.Copy
    Sheets("June").Select
    Range("A1").Select
    ActiveSheet.Paste
    
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.07.2019"
    Cells.Select
    Selection.Copy
    Sheets("July").Select
    Range("A1").Select
    ActiveSheet.Paste
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.08.2019"
    Cells.Select
    Selection.Copy
    Sheets("August").Select
    Range("A1").Select
    ActiveSheet.Paste
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.09.2019"
    Cells.Select
    Selection.Copy
    Sheets("September").Select
    Range("A1").Select
    ActiveSheet.Paste
    
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.10.2019"
    Cells.Select
    Selection.Copy
    Sheets("October").Select
    Range("A1").Select
    ActiveSheet.Paste
    
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.11.2019"
    Cells.Select
    Selection.Copy
    Sheets("November").Select
    Range("A1").Select
    ActiveSheet.Paste
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.12.2019"
    Cells.Select
    Selection.Copy
    Sheets("December").Select
    Range("A1").Select
    ActiveSheet.Paste
    
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.01.2020"
    Cells.Select
    Selection.Copy
    Sheets("January").Select
    Range("A1").Select
    ActiveSheet.Paste
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.02.2019"
    Cells.Select
    Selection.Copy
    Sheets("Febuary").Select
    Range("A1").Select
    ActiveSheet.Paste

End Sub
Sorry for the Length. But as you can see it is just the same code reused for each month with a line inserted at the start of each. But for some reason when it comes to the month of July I get a 'Subscript out of Range error' Seems odd that it only happens on July (so Far) when its code is no different than those around it.

Ideas?

Edit:

There is a gap between each months code the clumping is a copy paste error I assume.
 
Hi

I've not read the rest of this thread and agree it's not the most elegant code.
It's also going to fail in months which don't have 31 days.
Suggest you d a google search for code to get the last day of each month and loop through each month in turn
 
Cracked it. I accidently put a space in the name of July easy done.

Any ideas on how to refine and improve would be appreciated but as of right now its working fine for my purposes. I put in this line as well to send me back to the start page and remove the filters

Code: 
   Sheets("LongStayPermits").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1



Ill make the change for the months without 31 days thanks, slipped my mind that. ;)

Thanks
 
Do you have the July and later sheets?
If you try and go to a sheet not created, you will get that error.


June only has 30 days BTW, and I am presuming eveything for a month has the month end date?


As well as paying attention to what Colin has suggested, I'd ahve probably approached it with another sheet with the dates in a column and then walked through that range taking each date and using that in the code, so it would create a loop.


Again the For each Cell in Range("Your date range") would work well here.





bobunknown said:
Me again, i'm now attempting to refine the code for use in a spread sheet that covers every month of the year. I Know it is not the most elegant way or the quickest way but at this stage i'm just trying to get it to work.

Here is what I came up with so far:

Code: 
Private Sub Workbook_Open()
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.03.2019"
    Cells.Select
    Selection.Copy
    Sheets("March").Select
    Range("A1").Select
    ActiveSheet.Paste
    
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.04.2019"
    Cells.Select
    Selection.Copy
    Sheets("April").Select
    Range("A1").Select
    ActiveSheet.Paste
    
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.05.2019"
    Cells.Select
    Selection.Copy
    Sheets("May").Select
    Range("A1").Select
    ActiveSheet.Paste
    
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.06.2019"
    Cells.Select
    Selection.Copy
    Sheets("June").Select
    Range("A1").Select
    ActiveSheet.Paste
    
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.07.2019"
    Cells.Select
    Selection.Copy
    Sheets("July").Select
    Range("A1").Select
    ActiveSheet.Paste
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.08.2019"
    Cells.Select
    Selection.Copy
    Sheets("August").Select
    Range("A1").Select
    ActiveSheet.Paste
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.09.2019"
    Cells.Select
    Selection.Copy
    Sheets("September").Select
    Range("A1").Select
    ActiveSheet.Paste
    
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.10.2019"
    Cells.Select
    Selection.Copy
    Sheets("October").Select
    Range("A1").Select
    ActiveSheet.Paste
    
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.11.2019"
    Cells.Select
    Selection.Copy
    Sheets("November").Select
    Range("A1").Select
    ActiveSheet.Paste
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.12.2019"
    Cells.Select
    Selection.Copy
    Sheets("December").Select
    Range("A1").Select
    ActiveSheet.Paste
    
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.01.2020"
    Cells.Select
    Selection.Copy
    Sheets("January").Select
    Range("A1").Select
    ActiveSheet.Paste
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.02.2019"
    Cells.Select
    Selection.Copy
    Sheets("Febuary").Select
    Range("A1").Select
    ActiveSheet.Paste

End Sub
Sorry for the Length. But as you can see it is just the same code reused for each month with a line inserted at the start of each. But for some reason when it comes to the month of July I get a 'Subscript out of Range error' Seems odd that it only happens on July (so Far) when its code is no different than those around it.

Ideas?

Edit:

There is a gap between each months code the clumping is a copy paste error I assume.
Click to expand...
 
I don't believe that removes the filter, but sets the filter?, see what I posted to remove the filter previously.


bobunknown said:
Cracked it. I accidently put a space in the name of July easy done.

Any ideas on how to refine and improve would be appreciated but as of right now its working fine for my purposes. I put in this line as well to send me back to the start page and remove the filters

Code: 
   Sheets("LongStayPermits").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1

Ill make the change for the months without 31 days thanks, slipped my mind that. ;)




Thanks
Click to expand...
 
I wouldn't have it on on Open either, but call it from a macro button on the ribbon.?
I am sure there are times when you will want to open the workbook and not do all that processing?
 
The lines:

Code: 
  Sheets("LongStayPermits").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1

Were taken from the recorder. It is simply me navigating back to the starting page and opening the filters out to include every date.

I'm interested in your suggestion of creating a loop. Seems like something that would come in handy. you got any examples of it?

Additionally I know that every year the dates in the code will need altering, lees they fall out of use. Is there any way to filter based solely on month with the year being open ended. My hope is that this would let me create a master sheet that is copy and pasted as needed for the year and therefore reduce maintenance and people saying its stopped working every financial year.
 
See if you can slot this in with your code?


Code: 
Sub testLoop()
Dim intMonth As Integer, intDay As Integer, intYear As Integer
Dim strDate As String
intYear = Year(Date)

For intMonth = 1 To 12
    strDate = DateSerial(intYear, intMonth + 1, 0)
    Debug.Print strDate
Next

End Sub
the debug line is just to show the values, so comment out when complete.?
Also assumes the current year, so if you run on 2nd January for last years data, there will be a problem.?
 
Last edited:
I have inserted it at the head of the code I posted before, it now looks like this:

Code: 
Dim intMonth As Integer, intDay As Integer, intYear As Integer
Dim strDate As String
intYear = Year(2018)
For intMonth = 1 To 12
    strDate = DateSerial(intYear, intMonth + 1, 0)
    Debug.Print strDate
Next

It didn't seem to affect the workings of the existing code. But in the box below titled Immediate it returned a list of dates:

31/10/2018
30/11/2018
31/12/2018

This code creates a loop as you described before? walking through dates in a specific range?
 
Yes, as I stated, comment that out when you have it all working.
Don't hard code the year, that is why I used Date, it will change automatically for future years.

That code is the loop. the For Next needs to be at the start of your working code (but with only one version of it)

The Next statement should be at the bottom, so that your working code runs within that loop.

Then you need to change the date value being compared to the strDate variable

So then the loop runs 12 times, once for each month with the last date of the month

However what happens for July and onwards?, you should not have any data yet?, so will need to take that into account as well.?

I had this problem with my workbook, sometimes there was nothing to copy.

I solved that by checking I actually has a #N/A in my first row.
You will have to find another way, perhaps count the lines with something like

Code: 
lngNA = Range("A" & Rows.Count).End(xlUp).Row
    If (lngNA = 1) Then
        MsgBox "Second check: No rows to copy today, macro will terminate"
        'Set rng = Nothing
        GoTo Exit_Sub
    End If
 
Okey this is what I got:

Code: 
Private Sub Workbook_Open()
Dim intMonth As Integer, intDay As Integer, intYear As Integer
Dim strDate As String
intYear = Year(2019)
For intMonth = 1 To 12
    strDate = DateSerial(2019, 3 + 1, 0)
    Debug.Print strDate
 
Sheets("LongStayPermits").Select
    Columns("M:M").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1, Criteria1:= _
    "31.03.2019"
    Cells.Select
    Selection.Copy
    Sheets("March").Select
    Range("A1").Select
    ActiveSheet.Paste
Next
    
Sheets("LongStayPermits").Select
    ActiveSheet.Range("$M$1:$M$244").AutoFilter Field:=1

End Sub
at the moment it seems to be trying to copy data and work through the loop but is only attempting to copy in to the March sheet, for obvious reasons.

I'm trying to write something that would allow it to cycle through the sheets at the same time but let me know if you have any ideas.

Edit:

as for post June/July I have populated my table with some test data so that I can see if it is working.

Not urgent at this point, as I have it up and running, just trying to learn more than anything.
 
Last edited:
Thoroughly confused now? why are we working on 2019 data?
 
The lists I am creating are for the dates that parking permits, issued this year, expire.

To clarify the info in Column M:M that I am filtering is the parking permits expiry date. So if they were issued this year the date I am trying to find will be this time next year.
 
Last edited:
Ok, you will need to adapt this in someway. I was assuming dates in the year.?
I found that I was picking up the first row if I did not have any headers in the sheet, and that row was not in the criteria. I only tested for 3 months as well January to March this year.


I also found the code differed slightly when using dates :banghead:


This will do it for all the months in this year.
Now we need to determine where your start point is to change the date values?
Work with this for now though.


Code: 
Sub TestCode()
Dim intMonth As Integer, intDay As Integer, intYear As Integer
Dim strDate As String
Dim lngDataLen As Long
intYear = Year(Date)

Sheets("Sheet1").Select
'Columns("M:M").Select
Cells.Select
Selection.AutoFilter

For intMonth = 1 To 12
    strDate = Format(DateSerial(intYear, intMonth + 1, 0), "mm/dd/yyyy")
    Debug.Print strDate
    
    ActiveSheet.Range("$M:$M").AutoFilter Field:=1, Operator:= _
        xlFilterValues, Criteria2:=Array(1, strDate)
    lngDataLen = Range("M" & Rows.Count).End(xlUp).Row
    If lngDataLen > 1 Then
        ' Cells.Select
        Selection.Copy
        Sheets(MonthName(intMonth)).Range("A1").PasteSpecial
    End If
Next
    
Sheets("Sheet1").Select
    ActiveSheet.Range("$M:$M").AutoFilter Field:=1

End Sub
 
I am thinking now that a sheet with relevant dates in it, might be a better way to go rather than working out increments for year on month greater than 12 in the loop? The number of dates would control the loop.?



However only you know how you work, so you will have to elaborate some more, just in plain english on how it works at present.
 
You must log in or register to reply here.

Similar threads

Gasman
Solved Open Excel workbook, but have WorkBook_Open code run
Replies
19
Views
344
Gasman
Gasman
D
Copy only selected fields from 1 sheet to another
Replies
19
Views
1,092
dcavaiani
D
Z
Issue with VBA library
Replies
6
Views
711
amorosik
amorosik
mloucel
Solved Refresh a query thru VBA
Replies
7
Views
357
mloucel
mloucel
D
Solved How to quickly duplicate Tables & associated subforms within a main form
2 3 4
Replies
71
Views
1,627
dibblermail
D

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom