Can anyone see whats wrong with this?

JohnPoole

Active Member
Joined
Jun 9, 2005
Messages
254
Hi everyone, I've got a piece of code from a previous Mr Excel thread which looks at the date in column H, and if its older than 30 days it deletes the line and copies it to another sheet.

I've modified the code slightly so that it now looks at column A and just makes a copy of the line in another workbook instead if the date lis ess than the date shown in cell H1. ie if cell H1 contains the number 10, all lines with a date 10 days ago or less will be copied to the second workbook.

This works mostly, however say for example I have 10 lines, with various different dates in column A, lets say ranging from 10 to 100 days previous. If I look to copy lines less than 50 days old the procedure will work correctly, but if i try it with say 100 days it fails completely and tells me there are no lines to copy, even though i know there as it works with dates which are less than 50 days old.

I've tried it out with large samples of data, and using numbers 1-300 for the number of days back to search for and can find no reason why sometimes the procedure works and sometimes not.

A copy of the code i'm using is here

<font face=Courier New><SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Sub</SPAN> MBranch_Report_John()
Sheets("All").Select
daysback = [h1].Value
ChDir "W:\Cancellations\NEW ORDER BOOKS\Old order books\Newreport"
    Workbooks.Open Filename:= _
        "W:\Cancellations\NEW ORDER BOOKS\Old order books\Newreport\John.xls"
        
Sheets("Movement").Select

<SPAN style="color:#00007F">Dim</SPAN> LastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, CriDate <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Date</SPAN>, rng <SPAN style="color:#00007F">As</SPAN> Range
CriDate = Format(Date - daysback, "mm/dd/yyyy")
<SPAN style="color:#007F00">'CriDate = Format(Date - 30, "mm/dd/yyyy") ' this was the code for getting the date in the original thread.</SPAN>

Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN>

<SPAN style="color:#00007F">With</SPAN> Sheets("Movement")

    LastRow = .Cells(Rows.Count, "a").End(xlUp).Row
    .[a:a].AutoFilter Field:=1, Criteria1:=">" & CriDate <SPAN style="color:#007F00">' ive chnage column H to A, and criteria 1 from < to ></SPAN>
    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> rng = .Range("a27:a" & LastRow).SpecialCells(xlCellTypeVisible)
    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0
    <SPAN style="color:#00007F">If</SPAN> rng <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN>
        .[a:a].AutoFilter
        <SPAN style="color:#007F00">'.[b1].Select</SPAN>
        <SPAN style="color:#00007F">GoTo</SPAN> NoRows
    Else:
     Windows("CanxCodesReportX.xls").Activate
        rng.EntireRow.Copy Sheets("All").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
      
        <SPAN style="color:#007F00">'rng.Delete ' omitted this line so it no longer deltes the record after copying.</SPAN>
        .[a:a].AutoFilter
        <SPAN style="color:#007F00">'.[b1].Select</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    
    
    
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>

<SPAN style="color:#00007F">GoTo</SPAN> Xit
NoRows:
Err.Clear
MsgBox "No rows to report in John's Movement."

Xit:
<SPAN style="color:#00007F">Set</SPAN> rng = <SPAN style="color:#00007F">Nothing</SPAN>
Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN>

NDBranch_Report_John
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>

I've noted on there the bits i've changed to make it clearer...hopefully.

Can anyone tell me what the problem is, or if there is an easier solution to the problem?

As a further question, this procedure is actually run twice, once for the sheet call Movement, and again for a sheet called New Deals, is there anyway to implement a With statement so that it can perform the task on both sheets with out the need to call the procedure for each sheet?

Any help with this appreciated as always......
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,300
Office Version
  1. 365
Platform
  1. Windows
John

I don't know if it helps but there are various things in that code that could cause problems, mainly unqualified references like [A1], [H1], [A:A] etc

Because you use the [] notation, and not worksheet reference, then VBA will look at A1 etc on the active sheet, which may or may not be the correct one.
Code:
Public Sub MBranch_Report_John()

daysback = Sheets("All").Range("H1").Value

Workbooks.Open Filename:="W:\Cancellations\NEW ORDER BOOKS\Old order books\Newreport\John.xls"
        
Dim LastRow As Long, CriDate As Date, rng As Range
CriDate = Format(Date - daysback, "mm/dd/yyyy")
'CriDate = Format(Date - 30, "mm/dd/yyyy") ' this was the code for getting the date in the original thread.

Application.DisplayAlerts = False

With Sheets("Movement")
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    .Range("A:A").AutoFilter Field:=1, Criteria1:=">" & CriDate ' ive chnage column H to A, and criteria 1 from < to >
    On Error Resume Next
    Set rng = .Range("A27:A" & LastRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If rng Is Nothing Then
        .Range("A:A").AutoFilter
    Else
        Workbooks
        rng.EntireRow.Copy Workbooks("CanxCodesReportX.xls").Sheets("All").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
        .Range("A:A").AutoFilter
    End If
End With

GoTo Xit
NoRows:
Err.Clear
MsgBox "No rows to report in John's Movement."

Xit:
Set rng = Nothing
Application.DisplayAlerts = True

NDBranch_Report_John
End Sub
PS It might be worthwhile taking out any error handling to see if any errors are actually occurring.
 

JohnPoole

Active Member
Joined
Jun 9, 2005
Messages
254
Hi Norrie, thanks for the reply, ill give it a go and reply later, many thanks.
 

JohnPoole

Active Member
Joined
Jun 9, 2005
Messages
254

ADVERTISEMENT

Ok, ive tried that, unfortunately it gives exactly the same results, i've tried it with a single column, column A has the date 01/09/06 (49 days ago). This isnt picked up by the procedure using the value 85 ( 85 days ago is 27th July) in cell H1 - anything 85 days or less, but is picked up if we use 100 days . Any further thoughts?
 

JohnPoole

Active Member
Joined
Jun 9, 2005
Messages
254
I notice though that it no longer reports that there are no rows to report when it should be reporting.
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,300
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

John

Using Autofilter with VBA and dates can sometimes be tricky.

After taking another look at your code I notice you are using Format here.
Code:
CriDate = Format(Date - daysback, "mm/dd/yyyy")
Format returns a string, you've declared CriDate as a Date, so I'm not sure what's going to happen there.

Have you tried stepping through the code using F8?

One idea might be to add an extra column to the data with a formula that evaluates to True/False for the records you want.

Then you could filter on that column rather than the date column.
 

JohnPoole

Active Member
Joined
Jun 9, 2005
Messages
254
Thanks, ive taken the above into account and crteated a column (S) which evaulates each date to true or false and uses this to sort by. This solves the original problem, all records are now correctly identified and reported. This has however lead to another problem which didnt exist before:
If there are genuinely no records to report Excel gives me an eobject required error on the following line:

If rng Is Nothing Then

The full procedure as it stands is:

<font face=Courier New><SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Sub</SPAN> MBranch_Report_John()
dateback = Workbooks("CanxCodesReportX1.xls").Sheets("All").Range("i1").Value

Workbooks.Open Filename:="c:\xl\John.xls"
        
<SPAN style="color:#00007F">With</SPAN> Workbook
    Sheets("Movement").Select
    Range("s26").Value = dateback
        
    Sheets("New Deals").Select
    Range("n26").Value = dateback
    
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
        
Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN>

<SPAN style="color:#00007F">With</SPAN> Workbooks("John.xls").Sheets("Movement")
    LastRow = .Cells(Rows.Count, "S").End(xlUp).Row
    .Range("S:S").AutoFilter Field:=1, Criteria1:="TRUE"  <SPAN style="color:#007F00">' ive chnage column H to A, and criteria 1 from < to ></SPAN>
    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> rng = .Range("S27:S" & LastRow).SpecialCells(xlCellTypeVisible)
    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0
    <SPAN style="color:#00007F">If</SPAN> rng <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN>
        .Range("S:S").AutoFilter
    <SPAN style="color:#00007F">Else</SPAN>
        <SPAN style="color:#007F00">'Workbooks</SPAN>
        rng.EntireRow.Copy Workbooks("CanxCodesReportX1.xls").Sheets("All").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
        .Range("S:S").AutoFilter
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>

<SPAN style="color:#00007F">GoTo</SPAN> Xit
NoRows:
Err.Clear
MsgBox "No rows to report in John's Movement."

Xit:
<SPAN style="color:#00007F">Set</SPAN> rng = <SPAN style="color:#00007F">Nothing</SPAN>
Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN>

<SPAN style="color:#007F00">'NDBranch_Report_John</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>


Any ideas how this can be worked around?
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,300
Office Version
  1. 365
Platform
  1. Windows
Why not stick a CountIf in the code to see if there are any True values in the column?

You can access CountIf, and other worksheet functions, via Application.WorksheetFunction.

Code:
If Application.WorksheetFunction.CountIf(Range("S:S"), True) > 0 Then
    ' code to transfer records
Else
    Msgbox "No records found"
End If
 

JohnPoole

Active Member
Joined
Jun 9, 2005
Messages
254
Ok ive given this a go using the following;

<font face=Courier New><SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Sub</SPAN> MBranch_Report_John()
dateback = Workbooks("CanxCodesReportX1.xls").Sheets("All").Range("i1").Value

Workbooks.Open Filename:="c:\xl\John.xls"
        
<SPAN style="color:#00007F">With</SPAN> Workbook
    Sheets("Movement").Select
    Range("s26").Value = dateback
        
    <SPAN style="color:#007F00">'Sheets("New Deals").Select</SPAN>
    <SPAN style="color:#007F00">'Range("n26").Value = dateback</SPAN>
    
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
        
Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN>

<SPAN style="color:#00007F">With</SPAN> Workbooks("John.xls").Sheets("Movement")
    LastRow = .Cells(Rows.Count, "S").End(xlUp).Row
    .Range("S:S").AutoFilter Field:=1, Criteria1:="TRUE"  <SPAN style="color:#007F00">' ive chnage column H to A, and criteria 1 from < to ></SPAN>
    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> rng = .Range("S27:S" & LastRow).SpecialCells(xlCellTypeVisible)
    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0
    <SPAN style="color:#00007F">If</SPAN> Application.WorksheetFunction.CountIf(Range("S:S"), <SPAN style="color:#00007F">True</SPAN>) > 0 <SPAN style="color:#00007F">Then</SPAN>
        rng.EntireRow.Copy Workbooks("CanxCodesReportX1.xls").Sheets("All").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
        .Range("S:S").AutoFilter
    <SPAN style="color:#00007F">Else</SPAN>
        <SPAN style="color:#007F00">'Workbooks</SPAN>
        MsgBox "No records found"
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>

<SPAN style="color:#00007F">GoTo</SPAN> Xit
NoRows:
Err.Clear
MsgBox "No rows to report in John's Movement."

Xit:
<SPAN style="color:#00007F">Set</SPAN> rng = <SPAN style="color:#00007F">Nothing</SPAN>
Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN>

<SPAN style="color:#007F00">'NDBranch_Report_John</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>

but this seems to mess up the report sheet and the sheet called movement by deleting nearly everything. I guess im not dong the function call in the right way somewhere.
 

Forum statistics

Threads
1,136,421
Messages
5,675,759
Members
419,585
Latest member
popsin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top