Sleeper: MAcro Range Help

[Seb]

Private Sub CommandButton1_Click()
Dim rngName As Range, intResponse
    Dim strName As String
    ActiveSheet.Unprotect
strName = InputBox("Please Enter Guest Names", "Peverel Hall Hotel - Guest Confirmation")
On Error Resume Next
    Set rngName = Range(strName)
    If Err.Number = 0 Then          ' no error, name already exists
    MsgBox "Name already exists." & vbCr & vbCr & _
           "Please enter a different name.", _
           vbExclamation, "Naming Conflict"
    Exit Sub
End If
On Error GoTo handler
    ActiveWorkbook.Names.Add name:=strName, RefersTo:=Selection
    Selection.Interior.ColorIndex = 4
    Selection.FormulaR1C1 = "C"
handler:
        If Err.Number = 1004 Then
            MsgBox "You Have Entered No Data Or More Than 1 Word"
        End If
ActiveSheet.Protect
End Sub

I have this macro and i only want it to work for cells B3:ad14 please help

[Ken Puls]

Hi Seb,

Are you trying to make this:

ActiveWorkbook.Names.Add name:=strName, RefersTo:=Selection 
Selection.Interior.ColorIndex = 4 
Selection.FormulaR1C1 = "C"

Refer to ALL cells in B3:AD14 (every time), or are you saying that you only want it to work on the selected range at any one time, provided it is outside of that listed?

[Seb]

i only want the macro to work on cells b3:ad14

cause i have to highlight the cells and click on the button and if i click out of that range it doesnt work

[Ken Puls]

Hi Seb,

Try changing this:

ActiveSheet.Unprotect 
strName = InputBox("Please Enter Guest Names", "Peverel Hall Hotel - Guest Confirmation")

To this:

ActiveSheet.Unprotect
'Test if upper left cell is within range B3:AD14
    With Selection.Range("A1")
        If .Column < 2 Or .Row < 3 Then
            MsgBox "Sorry!  You selected cells " & Selection.Address & vbCrLf & _
                "which is outside of the allowable range of $B$3 to $AD$14." & vbCrLf & _
                "Please select a new range and try again!", vbOKOnly + vbCritical, _
                "Invalid selection!"
            Exit Sub
        End If
    End With
'Test if lower right cell is within range B3:AD14
    With Selection
        If .Range("A1").Column + .Columns.Count > 31 Or .Range("A1").Row + .Rows.Count > 15 Then
            MsgBox "Sorry!  You selected cells " & Selection.Address & vbCrLf & _
                "which is outside of the allowable range of $B$3 to $AD$14." & vbCrLf & _
                "Please select a new range and try again!", vbOKOnly + vbCritical, _
                "Invalid selection!"
            Exit Sub
        End If
    End With
strName = InputBox("Please Enter Guest Names", "Peverel Hall Hotel - Guest Confirmation")

HTH,

[Zack Barresse]

Hi,

You could try the Intersect command. ..

[vba]If Not Intersect(Selection, Range("B3:AD14")) Is Nothing Then
'matching code here
End If[/vba]

[Ken Puls]

Hey Zack,

Thanks for that. I stumbled on the intersect method trying to test the top left, and then the bottom right cell. The bottom right one got me. Didn't realize that you could just do the whole range at once!

Seb, use Zack's code. It's much more efficient, and will be way easier to maintain.

Cheers,

[mdmackillop]

Hi Seb,
You might want to check out WorksheetChange macros, where the macro is run by a changed value in a range. The Insersect method is commonly used to limit the triggering to the required cells.
MD

[Len Piwowar]

Select Target Range B3:AD14 and Define name as ValidRng1
You can re-define name in the future if your range changes and the macro would still work.

Edit macro as follows:

Private Sub CommandButton1_Click() 
Dim rngName As Range, intResponse 
Dim strName As String 
ActiveSheet.Unprotect 
MyRng = Application.ActiveCell.Address
Set isect = Application.Intersect(Range("ValidRng1"), Range(MyRng))
If Not isect Is Nothing Then
strName = InputBox("Please Enter Guest Names", "Peverel Hall Hotel - Guest Confirmation") 
On Error Resume Next 
Set rngName = Range(strName) 
If Err.Number = 0 Then ' no error, name already exists
MsgBox "Name already exists." & vbCr & vbCr & _ 
"Please enter a different name.", _ 
vbExclamation, "Naming Conflict" 
Exit Sub 
End If 
On Error Goto handler 
ActiveWorkbook.Names.Add name:=strName, RefersTo:=Selection 
Selection.Interior.ColorIndex = 4 
Selection.FormulaR1C1 = "C" 
handler: 
If Err.Number = 1004 Then 
MsgBox "You Have Entered No Data Or More Than 1 Word" 
End If 
End If  
ActiveSheet.Protect 
End Sub