I want to stop the code from running with a message prompt when the if condition is not met.
I have tried with an else before the end if statement but that doesn't seem to work.
I will really appreciate your help with this. Thanks in advanvce.
The if condition is nested in a for loop. Below is the section I am referring to:
For i = 2 To last_row
For ii = 8 To 1999
Sheets("Schedule View").Range("K3").Value = Sheets("Sheet1").Range("A" & i).Value
If Worksheets("Schedule View").Cells(ii, 25).Value = Worksheets("Schedule
View").Range("J3").Value And Worksheets("Schedule View").Cells(ii, 3).Value =
Worksheets("Schedule View").Range("K3").Value Then
With Worksheets("Schedule View")
.Range(.Cells(ii, 1), .Cells(ii, 25)).Copy
Worksheets("Sheet3").Activate
b = Worksheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet3").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Schedule View").Activate
End With
End If
Next
#Rest of code here
Next i
...
Full code below please.
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim i As Integer
Dim r As Integer
Dim rr As Long
Dim ColumnLetter As String
Dim last_row As Integer
last_row = Application.WorksheetFunction.CountIf(sh.Range("A:A"), "?*")
Dim rng As Range
Set rng = Nothing
On Error Resume Next
For i = 2 To last_row
For ii = 8 To 1999
Sheets("Schedule View").Range("K3").Value = Sheets("Sheet1").Range("A" & i).Value
'On Error Resume Next
If Worksheets("Schedule View").Cells(ii, 25).Value = Worksheets("Schedule
View").Range("J3").Value And Worksheets("Schedule View").Cells(ii, 3).Value =
Worksheets("Schedule View").Range("K3").Value Then
'On Error Resume Next
With Worksheets("Schedule View")
.Range(.Cells(ii, 1), .Cells(ii, 25)).Copy
Worksheets("Sheet3").Activate
b = Worksheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet3").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Schedule View").Activate
End With
End If
Next
Worksheets("Sheet3").Activate
r = ActiveSheet.Range("A1").End(xlDown).Row
rr = r - 24
Worksheets("Sheet3").Range("A26", "Y" & r).Select
Worksheets("Sheet3").Range("A26", "Y" & r).Copy
Worksheets("Sheet3").Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Worksheets("Sheet3").Range("A26", "Y" & r).Delete
Application.CutCopyMode = False
'Convert To Column Letter
ColumnLetter = Split(Cells(1, rr).Address, "$")(1)
Set rng = Sheets("Sheet3").Range("A1", ColumnLetter & "25").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)
olMail.To = sh.Range("B" & i).Value
olMail.Subject = sh.Range("C" & i).Value
olMail.BodyFormat = olFormatHTML
olMail.HTMLBody = RangetoHTML(rng)
olMail.Send
MsgBox ("Roster sent to " + sh.Range("A" & i).Value)
Next i
End Sub
Exit For?