Can anyone see whats wrong with this?

JohnPoole · Oct 19, 2006

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

Public Sub 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

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
 .[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
 .[a:a].AutoFilter
 '.[b1].Select
 GoTo NoRows
 Else:
 Windows("CanxCodesReportX.xls").Activate
 rng.EntireRow.Copy Sheets("All").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)

 'rng.Delete ' omitted this line so it no longer deltes the record after copying.
 .[a:a].AutoFilter
 '.[b1].Select
 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


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......

JohnPoole · Oct 20, 2006

Bumped for help please....

Norie · Oct 20, 2006

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 · Oct 20, 2006

Hi Norrie, thanks for the reply, ill give it a go and reply later, many thanks.

JohnPoole · Oct 20, 2006

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 · Oct 20, 2006

I notice though that it no longer reports that there are no rows to report when it should be reporting.

Norie · Oct 20, 2006

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 · Oct 21, 2006

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:

Public Sub MBranch_Report_John()
dateback = Workbooks("CanxCodesReportX1.xls").Sheets("All").Range("i1").Value

Workbooks.Open Filename:="c:\xl\John.xls"

With Workbook
 Sheets("Movement").Select
 Range("s26").Value = dateback

 Sheets("New Deals").Select
 Range("n26").Value = dateback

End With

Application.DisplayAlerts = False

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


Any ideas how this can be worked around?

Norie · Oct 21, 2006

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 · Oct 21, 2006

Ok ive given this a go using the following;

Public Sub MBranch_Report_John()
dateback = Workbooks("CanxCodesReportX1.xls").Sheets("All").Range("i1").Value

Workbooks.Open Filename:="c:\xl\John.xls"

With Workbook
 Sheets("Movement").Select
 Range("s26").Value = dateback

 'Sheets("New Deals").Select
 'Range("n26").Value = dateback

End With

Application.DisplayAlerts = False

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


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.

Can anyone see whats wrong with this?

JohnPoole

Active Member

Excel Facts

JohnPoole

Active Member

Norie

Well-known Member

JohnPoole

Active Member

JohnPoole

Active Member

JohnPoole

Active Member

Norie

Well-known Member

JohnPoole

Active Member

Norie

Well-known Member

JohnPoole

Active Member

Similar threads

Forum statistics

Share this page

Can anyone see whats wrong with this?

Active Member

Excel Facts

Active Member

Well-known Member

Active Member

Active Member

Active Member

Well-known Member

Active Member

Well-known Member

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock