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. ..

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

[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.:yes 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