how to make this vba code active row not cell

Originally Posted by shg

Could you provide a little context?

hi

basically im trying to a stop command button from working e.g if a13 to a500 has 133 enter in cell,the problem i have got is that if the cell is not first cell selected ie the active one the command button will work if i was to select cell from m13 to a13 the command button would work this why i think active row would work better but can seem to get it to work hope this helps. The macro is mail selection email button
many thanks again
shane

Option Explicit

Sub Mail_Selection_Outlook_Body()

   If Not Application.Intersect(ActiveCell, Range("A13:A500")) Is Nothing And ActiveCell.Value = 133 Or ActiveCell.Value = 122 Then
    MsgBox "        not allow number! "
    Exit Sub
   End If
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
 
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
 
    Set rng = Nothing
    On Error Resume Next
    Set rng = Selection.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
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = RangetoHTML(rng)
        .Display   'or use .Send
    End With
    On Error GoTo 0
 
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Sub Mail_Range_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
 
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
 
    Set rng = Nothing
    On Error Resume Next
    Set rng = Sheets("MailRangeSelection").Range("B19:B24").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
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = RangetoHTML(rng)
        .Display   'or use .Send
    End With
    On Error GoTo 0
 
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub