willow1985
Well-known Member
- Joined
- Jul 24, 2019
- Messages
- 888
- Office Version
- 365
- Platform
- 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!!
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