Help with an Else If filtered column has a particular value proceed, if not end.

[willow1985]

I have included my code below and marked where I would like a condition (the sentence in capitals).

Basically what I would like to achieve is after all columns are filtered if there is no "No" value in visible cells in column 32, to clear the filters and end the Macro with a message but if there is a "No" value to proceed with the code.

Thank you to anyone who can help!!

Sub CEG_Declined()
'
' CEG_Declined Macro
'
   Msg = "Declined Letters will be created for all individuals who have not been recorded as receiving a Letter." & vbCrLf & vbCrLf & "These Letters will be saved to the following Directory: X:\QUALITY\Quality Assurance\Controlled Goods\Letters to be Distributed" & vbCrLf & vbCrLf & "Do you wish to proceed?"

    Ans = MsgBox(Msg, vbYesNo)

    Select Case Ans

        Case vbYes

Application.ScreenUpdating = False
    
    Sheets("Assessment").Select
    Dim lo As ListObject
  For Each lo In ActiveSheet.ListObjects
    lo.AutoFilter.ShowAllData
      Next lo
      If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
  ActiveSheet.ShowAllData
End If

    Sheets("Letter List").Select
    For Each lo In ActiveSheet.ListObjects
    lo.AutoFilter.ShowAllData
      Next lo
      If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
  ActiveSheet.ShowAllData
End If
    Rows("3:3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=""Declined"""
    
    Sheets("Assessment").Select
    'Show Blank Cells Date Approved Letter Distributed
    ActiveSheet.ListObjects("Assessment").Range.AutoFilter Field:=33, Criteria1 _
        :="="
    'Show Blank Cells Date Declined Letter Distributed
    ActiveSheet.ListObjects("Assessment").Range.AutoFilter Field:=34, Criteria1 _
        :="="
    'Show CEG Declined only
    ActiveSheet.ListObjects("Assessment").Range.AutoFilter Field:=32, Criteria1 _
        :="No"

' HERE I WOULD LIKE A CONDITION IF THE VISABLE CELLS IN COLUMN 32 CONTAIN "No" THEN PROCEED WITH THE BELOW CODE. IF THEY ARE BLANK, CLEAR THE FILTERS AND GIVE A MESSAGE STATING "There are no Declined Letters to Export" and end the macro.


    With Worksheets("Assessment").AutoFilter.Range
    Range("B" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
    End With
    ActiveCell.Range("Assessment[[#Headers],[Emp '#]:[Last Name]]").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Letter List").Select
    
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("D2").Select
    Selection.Copy
    Sheets("Assessment").Select
    With Worksheets("Assessment").AutoFilter.Range
    'Record Declined Letter sent Date
       Range("AH" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
    End With
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    For Each lo In ActiveSheet.ListObjects
    lo.AutoFilter.ShowAllData
      Next lo
      If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
  ActiveSheet.ShowAllData
End If
    Range("A1").Select
    
    Application.DisplayAlerts = False
    
    ActiveWorkbook.Save
    
    Application.DisplayAlerts = True
    
    
    Set wd = CreateObject("word.application")
wd.Application.documents.Open "X:\QUALITY\Quality Assurance\Controlled Goods\Security Assessment - Negative Result.docx"
wd.Application.Visible = True
wd.Application.Run "NewMacros.Negative_Result_Letters"
Set wd = Nothing

Application.ScreenUpdating = True

MsgBox "Declined Letters Exported to:" & vbCrLf & "X:\QUALITY\Quality Assurance\Controlled Goods\Letters to be Distributed"
        Case vbNo
        GoTo Quit:
    End Select

Quit:
    
End Sub

 

[Fluff]

How about

If ActiveSheet.ListObjects("Assessment").ListColumns(32).Range.SpecialCells(xlVisible).Count = 1 Then
   MsgBox "nothing"
   Exit Sub
End If

 

[willow1985]

How about

If ActiveSheet.ListObjects("Assessment").ListColumns(32).Range.SpecialCells(xlVisible).Count = 1 Then
   MsgBox "nothing"
   Exit Sub
End If

Is there a way to clear all filters and have the MsgBox?

 

[Fluff]

Yup, like

If ActiveSheet.ListObjects("Assessment").ListColumns(32).Range.SpecialCells(xlVisible).Count = 1 Then
   MsgBox "nothing"
   ActiveSheet.ListObjects("Assessment").AutoFilter.ShowAllData
   Exit Sub
End If

 

[willow1985]

Yup, like

If ActiveSheet.ListObjects("Assessment").ListColumns(32).Range.SpecialCells(xlVisible).Count = 1 Then
   MsgBox "nothing"
   ActiveSheet.ListObjects("Assessment").AutoFilter.ShowAllData
   Exit Sub
End If

Works perfect! Thank you very much ? ?

 

[Fluff]

Glad to help & thanks for the feedback.