I can move completed rows (date populated "M" column) however I have more rows that are not completed moving with them. I have reviewed my code and can not find my problemWC DLV & BLD DATES.xls
many thanks
I can move completed rows (date populated "M" column) however I have more rows that are not completed moving with them. I have reviewed my code and can not find my problemWC DLV & BLD DATES.xls
many thanks
could you post your code?
Sub auto_open()
Worksheets(1).Select
Worksheets(1).Range("A3:M500").Select
Selection.Sort Key1:=Range("M1"), Order1:=xlAscending, Key2:=Range("A1") _
, Order2:=xlAscending, Key3:=Range("B1"), Order3:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Worksheets(2).Select
Worksheets(2).Range("A3:M500").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
, Order2:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Worksheets(2).Range("A3").Select
Worksheets(1).Select
Call purge_completed
Worksheets(1).Select
End Sub
Sub purge_completed()
On Error GoTo abort
Application.DisplayAlerts = False
Dim FilterCriteria
Dim newrange As Range
Range("A3:M500").Select
'Apply Autofilter
Selection.AutoFilter
'FilterCriteria = "<>"
Selection.AutoFilter field:=10, Criteria1:="<>"
'Worksheets(1).AutoFilter.Range.Offset(1).Select
Set newrange = Worksheets(1).AutoFilter.Range.Offset(1, 0).Resize(Worksheets(1).AutoFilter.Range.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
newrange.Select
'Selection.SpecialCells(xlCellTypeVisible).Select
'Rows(1).Hidden = True
'MsgBox (Selection.Rows.Count)
If (Selection.Rows.Count = 1) And (Range("M1").Value = "PD DATE") Then GoTo abort
'Copy the cells
Selection.Copy
Worksheets(2).Select
Worksheets(2).Range("A3").Select
Dim i As Integer
For i = 3 To 500
If ActiveCell.Value = Empty Then
GoTo found_empty_cell
Else
Worksheets(2).Range("A" & i).Select
End If
Next i
found_empty_cell:
ActiveSheet.Paste
'Clear the clipboard contents
Application.CutCopyMode = False
'Go back to the original file
Worksheets(1).Select
Selection.Delete
'Clear the autofilter
abort:
Selection.AutoFilter field:=1
'Take the Autofilter off
Selection.AutoFilter
Range("A3").Select
GoTo endofsub
'errorcatch:
'MsgBox ("No completed items to move.")
endofsub:
End Sub
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks