IF ELSE VBA not working [closed]

2019-08-21 06:43发布

Been working on this code and still can't get it to work. I've tried to piece it together through searching and copying similar codes but been unsuccessful at duplicating the solutions given.

I have Worksheet A and Worksheet B. I have table A on Worksheet A and table B on Worksheet B. I want to autofilter Table A and copy the results ("Quick Status" column="closed") (excluding header info) to bottom of table B.

If that criteria is met ("Quick Status" column ="closed"), it copies those rows with "closed" as the criteria in the "Quick Status" column and pastes it over on the other sheet and then deletes the data from Table A. Works as intended.

However if I have a day where I did not close any files, autofilter would return no results. That is when the issue occurs. When I am stepping thru it in the debugger - it continues thru the "IF" portion and gets stuck at

   Range(Selection, Selection.End(xlDown)).SpecialCells   (xlCellTypeVisible).Copy

Not sure why it doesn't stop at the IF portion and move down to Else. The If portion should detect that the results are less then 1 so it should clear the filters and then populate a msg box informing the user that they did not close any files that day.

"PendA" is name of Table A. "Quick Status" is name of Column in Table A that I am searching for the criteria "Closed". Table A starts on B14. And ends on Column L.

Sub MoveC()
'
' MoveC Macro


Dim rng As Range, res As Variant, lrow As Long


Set rng = ActiveSheet.ListObjects("PendA").AutoFilter.Range.Rows(1)
res = Application.Match("Quick Status", rng, 0)
rng.AutoFilter Field:=res, Criteria1:="Closed"

lrow = ActiveSheet.Cells(Rows.Count, res).End(xlUp).Row + 1



If ActiveSheet.Range(Cells(1, res), Cells(lrow, res)).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
    Range("B15:L15").Select
    Range(Selection, Selection.End(xlDown)).SpecialCells(xlCellTypeVisible).Copy


    Sheets("Closed").Select
    Range("A2000").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


    Sheets("Pending").Select
    Application.DisplayAlerts = False
    ActiveSheet.ListObjects("PendA").DataBodyRange.Rows.Delete
    ActiveSheet.ListObjects("PendA").Range.AutoFilter Field:=8


Else

    ActiveSheet.ListObjects("PendA").Range.AutoFilter Field:=8

    MsgBox "No Closures found. Should have taken a PTO today."

End If

End Sub

1条回答
等我变得足够好
2楼-- · 2019-08-21 07:00

Overall there is a better way to structure your code for accuracy, maintainability and ease of reading.

Try the below. It checks for instances of "Closed" in the column before the filter.

Sub MoveC()

    Dim PendATbl as ListObject
    Set PendATbl = Worksheets("A").ListObjects("PendA") 'change as needed

    With PendATbl

        If Not .ListColumns("Quick Status").DataBodyRange.Find("Closed", lookat:=xlWhole) Is Nothing Then

            .ListColumns("Quick Status").Range.AutoFilter 1, "Closed"
            .DataBodyRange.SpecialCells(xlCellTypeVisible).Copy

             Sheets("Closed").Range("A2000").End(xlUp).Offset(1).PasteSpecial xlPasteValues

            .DataBodyRange.Rows.Delete

        Else

           .Range.AutoFilter Field:=8
            MsgBox "No Closures found. Should have taken a PTO today."

        End If 

    End With

End Sub
查看更多
登录 后发表回答