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

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
735
Office Version
  1. 365
Platform
  1. Windows
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!!

VBA Code:
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
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,220
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
If ActiveSheet.ListObjects("Assessment").ListColumns(32).Range.SpecialCells(xlVisible).Count = 1 Then
   MsgBox "nothing"
   Exit Sub
End If
 

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
735
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,220
Office Version
  1. 365
Platform
  1. Windows
Yup, like
VBA Code:
If ActiveSheet.ListObjects("Assessment").ListColumns(32).Range.SpecialCells(xlVisible).Count = 1 Then
   MsgBox "nothing"
   ActiveSheet.ListObjects("Assessment").AutoFilter.ShowAllData
   Exit Sub
End If
 
Solution

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
735
Office Version
  1. 365
Platform
  1. Windows
Yup, like
VBA Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,220
Office Version
  1. 365
Platform
  1. Windows
Glad to help & thanks for the feedback.
 

Forum statistics

Threads
1,140,999
Messages
5,703,641
Members
421,307
Latest member
morrden86

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top