Restricting macro to range

Sullie08
StarLounger
Posts: 59
Joined: 30 Jun 2017, 09:43

Restricting macro to range

Post by Sullie08 »

Hi,
I have written a macro to allow users to merge cells. The macro is limited to a set range of cells be defining the min/mac row & column numbers.
The sheet is used to record the results of test samples & can have between 100-120 samples, unused cells are greyed out with conditional formatting. My macro will only restrict merging cells within the 120 sample range but I've been asked to change it to prevent merging greyed out cells.
I need the rowNum > 133 in the invalid selection to change based on the number of samples. If 100 samples are needed then 133 should be 113.
I tried define LastRow as integer & change 133 to LastRow, the number of samples is in Cell L7 & needs +13 to align with the spreadsheet layout. The correct value appears in a message box but the macro still allows cells outside to merge.

Code: Select all

Sub MyMergeCells()

Dim ws As Worksheet
Dim rStart As Range
Set ws = Worksheets("Correlation")
Set rStart = Selection
colNum = Selection.Column
rowNum = Selection.Row

    If rStart.Columns.Count > "1" Or colNum < 3 Or colNum > 7 Or rowNum < 14 Or rowNum > 133 Then
        MsgBox "Invalid Selection"
        Exit Sub
   
    Else
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect "admin"
    Selection.Merge
    ActiveCell.HorizontalAlignment = xlCenter
    ActiveCell.VerticalAlignment = xlCenter
    ActiveCell.WrapText = True
    ActiveSheet.Protect "admin"
    Application.ScreenUpdating = True
    End If
    

End Sub

snb
5StarLounger
Posts: 619
Joined: 14 Nov 2012, 16:06

Re: Restricting macro to range

Post by snb »

You should always avoid merged cells.
Why would you need them ?

User avatar
p45cal
2StarLounger
Posts: 171
Joined: 11 Jun 2012, 20:37

Re: Restricting macro to range

Post by p45cal »

Just minimal changes to your code, try:

Code: Select all

Sub MyMergeCells()
Dim ws As Worksheet
Dim rStart As Range
Set ws = Worksheets("Correlation")
Set rStart = Selection
With ws
  Set rngAllowMerging = .Range("C14").Resize(.Range("C7").Value, 7)
  Set rngToMerge = Intersect(Selection, rngAllowMerging)
  If rngToMerge Is Nothing Then
    MsgBox "Invalid Selection"
    Exit Sub
  Else
    If rStart.Columns.Count > 1 Or rngToMerge.Address <> Selection.Address Then
      MsgBox "Invalid Selection"
      Exit Sub
    Else
      Application.ScreenUpdating = False
      .Unprotect "admin"
      Selection.Merge
      ActiveCell.HorizontalAlignment = xlCenter
      ActiveCell.VerticalAlignment = xlCenter
      ActiveCell.WrapText = True
      .Protect "admin"
      Application.ScreenUpdating = True
    End If
  End If
End With
End Sub