Update Validation in Merged Cells

[MartinS]

The idea is to simplify the validation for all cells on specific tabs that contain a certain validation formula, but what I'm finding is that it is applying the validation to each cell of a merged cell.
i.e. cells E54 (merged with F54) contains the specific validation, so I only want to set the validation for E54, but my code is applying the validation to F54 as well!
What am I missing?

Sub UpdateValidation()
'Declare procedure level variables
Dim wks As Worksheet
Dim rngSpecialCells As Range
Dim rngCell As Range
    'Loop through evert worksheet
    For Each wks In ThisWorkbook.Worksheets
        'Only interested in specific tabs
        If InStr(1, wks.Name, "Basis Switch", vbTextCompare) > 0 Then
            'Unprotect the sheet
            wks.Unprotect
            'Get all the cells that contain a validation rule
            Set rngSpecialCells = wks.Cells.SpecialCells(xlCellTypeAllValidation)
            For Each rngCell In rngSpecialCells
                If rngCell.Validation.Type = xlValidateList Then
                    If rngCell.Validation.Formula1 = "=IF(AND(VBSComp_CurvesUsed=SelectYes,VBSComp_Steps=SelectTwoStep),SelectRuns2Step,SelectRuns1Step)" Then
                        With rngCell.Validation
                            .Delete
                            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=SelectRuns1Step"
                            .IgnoreBlank = True
                            .InCellDropdown = True
                            .InputTitle = ""
                            .ErrorTitle = ""
                            .InputMessage = ""
                            .ErrorMessage = ""
                            .ShowInput = True
                            .ShowError = False
                        End With
                    End If
                End If
            Next rngCell
            'Re-protect the worksheet
            wks.Protect
        End If
    'Repeat for the next sheet
    Next wks
End Sub

 

[MartinS]

Actually, I just needed to take a break from it and the answer was easy!

Private Sub UpdateValidation()
'Declare procedure level variables
Dim wks As Worksheet
Dim rngSpecialCells As Range
Dim rngCell As Range
    'Loop through evert worksheet
    For Each wks In ThisWorkbook.Worksheets
        'Only interested in specific tabs
        If InStr(1, wks.Name, "Basis Switch", vbTextCompare) > 0 Then
            'Unprotect the sheet
            wks.Unprotect
            'Get all the cells that contain a validation rule
            Set rngSpecialCells = wks.Cells.SpecialCells(xlCellTypeAllValidation)
            'Loop through the selected cells
            For Each rngCell In rngSpecialCells
                'If it is part of merged cells and the first cell in that range
                   If rngCell.MergeCells And rngCell.Address = rngCell.MergeArea.Cells(1, 1).Address Then
                    'And it's a validation list
                    If rngCell.Validation.Type = xlValidateList Then
                        'Check and replace the validation formula
                        If rngCell.Validation.Formula1 = "=IF(AND(VBSComp_CurvesUsed=SelectYes,VBSComp_Steps=SelectTwoStep),SelectRuns2Step,SelectRuns1Step)" Then
                            With rngCell.Validation
                                .Delete
                                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=SelectRuns1Step"
                                .IgnoreBlank = True
                                .InCellDropdown = True
                                .InputTitle = ""
                                .ErrorTitle = ""
                                .InputMessage = ""
                                .ErrorMessage = ""
                                .ShowInput = True
                                .ShowError = False
                            End With
                        End If
                    End If
                 End If
            Next rngCell
            'Re-protect the worksheet
            wks.Protect
        End If
    'Repeat for the next sheet
    Next wks
End Sub

I just added another check to confirm that the cell was part of a merged range and the first cell in that range, ignoring all others.

 

[MartinS]

Actually, that wasn't right!

Private Sub UpdateValidation()
'Declare procedure level variables
Dim wks As Worksheet
Dim rngSpecialCells As Range
Dim rngCell As Range
    'Loop through evert worksheet
    For Each wks In ThisWorkbook.Worksheets
        'Only interested in specific tabs
        If InStr(1, wks.Name, "Basis Switch", vbTextCompare) > 0 Then
            'Unprotect the sheet
            wks.Unprotect
            'Get all the cells that contain a validation rule
            Set rngSpecialCells = wks.Cells.SpecialCells(xlCellTypeAllValidation)
            'Loop through the selected cells
            For Each rngCell In rngSpecialCells
                'If it is part of merged cells and the first cell in that range
                If rngCell.MergeCells And rngCell.Address = rngCell.MergeArea.Cells(1, 1).Address Then
                    'And it's a validation list
                    If rngCell.Validation.Type = xlValidateList Then
                        'If specific formula applied
                        If rngCell.Validation.Formula1 = "=IF(AND(VBSComp_CurvesUsed=SelectYes,VBSComp_Steps=SelectTwoStep),SelectRuns2Step,SelectRuns1Step)" Then
                            'Delete the validation for all cells in the range
                            rngCell.MergeArea.Validation.Delete
                            'Re-apply the validation to the first cell
                            With rngCell.Validation
                                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=SelectRuns1Step"
                                .IgnoreBlank = True
                                .InCellDropdown = True
                                .InputTitle = ""
                                .ErrorTitle = ""
                                .InputMessage = ""
                                .ErrorMessage = ""
                                .ShowInput = True
                                .ShowError = False
                            End With
                        End If
                    End If
                End If
            Next rngCell
            'Re-protect the worksheet
            wks.Protect
        End If
    'Repeat for the next sheet
    Next wks
End Sub

 

[MartinS]

I realised that somehow the validation had been applied to both cells of the merge, then merged together. My final change to delete all validation for the merged cells prior to adding the new validation to the merge area works as required.

Private Sub UpdateValidation()
'Declare procedure level variables
Dim rngCell         As Range
Dim rngSpecialCells As Range
Dim wks             As Worksheet
'Declare procedure level constants
Const cstrOldFormula As String = "=IF(AND(VBSComp_CurvesUsed=SelectYes,VBSComp_Steps=SelectTwoStep),SelectRuns2Step,SelectRuns1Step)"
Const cstrNewFormula As String = "=SelectRuns1Step"
    'Loop through evert worksheet
    For Each wks In ThisWorkbook.Worksheets
        'Only interested in specific tabs
        If InStr(1, wks.Name, "Basis Switch", vbTextCompare) > 0 Then
            'Unprotect the sheet
            wks.Unprotect
            'Get all the cells that contain a validation rule
            Set rngSpecialCells = wks.Cells.SpecialCells(xlCellTypeAllValidation)
            'Loop through the selected cells
            For Each rngCell In rngSpecialCells
                'If it is part of merged cells and not the first cell in that range
                If rngCell.MergeCells And Not rngCell.Address = rngCell.MergeArea.Cells(1, 1).Address Then
                    'Skip the rest of the loop
                    GoTo SkipUpdate
                End If
                'If the cell contains a validation list
                If rngCell.Validation.Type = xlValidateList Then
                    'And the cell has a specific formula
                    If rngCell.Validation.Formula1 = cstrOldFormula Then
                        'If the cell is part of a merge, delete the validation for all cells in the range
                        If rngCell.MergeCells Then
                            rngCell.MergeArea.Validation.Delete
                        End If
                        'Re-apply the validation rule to the merged cells
                        With rngCell.MergeArea.Validation
                            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                                Operator:=xlBetween, Formula1:=cstrNewFormula
                            .IgnoreBlank = True
                            .InCellDropdown = True
                            .InputTitle = ""
                            .ErrorTitle = ""
                            .InputMessage = ""
                            .ErrorMessage = ""
                            .ShowInput = True
                            .ShowError = False
                        End With
                    End If
                End If
SkipUpdate:
            Next rngCell
            'Re-protect the worksheet
            wks.Protect
        End If
    'Repeat for the next sheet
    Next wks
End Sub

 

[Joe4]

Note that merged cells are probably one of the worst features in Excel, and cause all sorts of issues for things like VBA, sorting, etc.
They are so bad that most serious programmers will NOT ever use them!

However, if you are just merging columns along single rows (like E54 and F54), you can instead use the "Center Across Selection" formatting option, which gives you the same visual effect as using merged cells, but without all the headaches that merged cells cause.
See here for instructions on how to do that: Tom’s Tutorials For Excel: Using Center Across Selection Instead of Merging Cells – Tom Urtis
(and avoid using merged cells whenever possible!)

 

[MartinS]

Note that merged cells are probably one of the worst features in Excel, and cause all sorts of issues for things like VBA, sorting, etc.
They are so bad that most serious programmers will NOT ever use them!

However, if you are just merging columns along single rows (like E54 and F54), you can instead use the "Center Across Selection" formatting option, which gives you the same visual effect as using merged cells, but without all the headaches that merged cells cause.
See here for instructions on how to do that: Tom’s Tutorials For Excel: Using Center Across Selection Instead of Merging Cells – Tom Urtis
(and avoid using merged cells whenever possible!)

Thanks Joe. I appreciate your reply, I'm working on a spreadsheet mostly created by the business I work for, so whilst merging isn't ideal, and in lots of cases, the merge isn't centred, I'm not looking to change the layout anytime soon as it covers hundreds of rows across 20+ worksheets, all with similar design/layout.
Regards
Martin

 

[Joe4]

in lots of cases, the merge isn't centred

That's odd. In those cases, what is the point of merging then?

 

[MartinS]

That's odd. In those cases, what is the point of merging then?

The worksheets contains blocks of text/data input and formulae, and the column widths just don't always suit a cell further down, so the cells are then merged to allow the user to see the full value. The layout is awful, but way too much time (and cost to the business) to re-write/re-format.

 

[Joe4]

The worksheets contains blocks of text/data input and formulae, and the column widths just don't always suit a cell further down, so the cells are then merged to allow the user to see the full value. The layout is awful, but way too much time (and cost to the business) to re-write/re-format.

Yeah, seems unnecessary in that case. As long as you don't have the "Wrap Text" setting set, it will just spill over into the next cell without having to merge it.
But I get inheriting poorly formatted spreadsheets/projects...

 

[MartinS]

As long as you don't have the "Wrap Text" setting set, it will just spill over into the next cell without having to merge it.

Oh they have that too!!