Looping Problem !!!

[mbarnett]

Hi All,

I have a code that works pretty good, but if a user enters a date in the input box that does not match the data I'm filtering it keeps looping. I tried IsEmpty, but with no luck. If the data that is being filtered is outside my date range and the filter is Null. My macro keeps looping. I've attached the code below - Help would be greatly appreciated. Thanks -

Option Explicit

Sub FilterCurrentDate()
Dim a, b, mydate

mydate = InputBox("Enter Your Value Date&quot
If Len(mydate) = 0 Then
'it will exit sub if you hit Cancel Button on the Excel File
Else
Columns("A:I&quot.Select
Selection.ClearContents

Windows("Me.xls&quot.Activate

Columns("C:C&quot.Select
Selection.NumberFormat = "mm/dd/yy"
Range("A1&quot.Select

a = "=" & Format(mydate, "mm/dd/yy&quot
b = ">" & Format(mydate, "mm/dd/yy&quot
Selection.AutoFilter Field:=3, Criteria1:=a, Operator:=xlOr, _
Criteria2:=b

End If
End Sub

Sub PastMyData()
Dim rngRow As Range, rngCol As Range, ws As Worksheet, lRow As Long
Dim r As Variant, c As Variant

FilterCurrentDate
Set ws = Workbooks("NewFile.xls&quot.Worksheets("Summary&quot
lRow = 1

With Workbooks("Me&quot.Worksheets("Data&quot

Set rngRow = Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
Set rngCol = Range(.Cells(1, 1), .Cells(1, 1).End(xlToRight))
For Each r In rngRow.SpecialCells(xlCellTypeVisible)
For Each c In rngCol
ws.Cells(lRow, c.Column).Value = .Cells(r.Row, c.Column).Value
Next
lRow = lRow + 1
Next
End With

End Sub

 

[cbhnp]

Have you tried IsDate?

 

[steveouthwaite]

Your problem is the line:

Set rngRow = Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))

if there is no data after autofiltering, .Cells(1, 1).End(xlDown) will refer to the bottom line in your weorksheet(row 65536)

try putting in the line...

If .Cells(r.Row, 3).Value = "" Then Exit For

after

lRow = lRow + 1

One problem with this is that if your data has any rows without dates, it will stop copying at that point

Good luck
SteveO