Home » excel » excel – VBA – Change cell value when clicked from/to yes/no for multiple merged cells

excel – VBA – Change cell value when clicked from/to yes/no for multiple merged cells

Posted by: admin May 14, 2020 Leave a comment

Questions:

I have created a form that will give the user the choice to pick from 7 different options which will all be default blank. When they click the cell next to the option it will change from blank to “yes” and when clicked again it will remove the text and so on. Cells R33 and S33 are merged and the code works fine there but i need the code to run across multipe cells that are also merged such as (R35-S35, R37-S37, R39-S39 & R41-S41.

Can you help me out with this please?

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

    Application.EnableEvents = False

    If Not Intersect(Target, Range("R33").MergeArea) Is Nothing Then
        Select Case True
        Case Target.Cells(1) = "yes"
            Target.Cells(1) = ""
        Case Target.Cells(1) = ""
            Target.Cells(1) = "yes"
        End Select
        Range("A1").Select
    End If

    Application.EnableEvents = True

End Sub
How to&Answers:

You can select multiple cells and that should be accounted for. A static union of the merge areas will not have to be redefined on every selection.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    static mrng as range

    if mrng is nothing then
        set mrng = union(cells(33, "R").mergearea, cells(35, "R").mergearea, _
                         cells(37, "R").mergearea, cells(39, "R").mergearea, _
                         cells(41, "R").mergearea)
    end if

    If Not Intersect(Target, mrng) Is Nothing Then
        Application.EnableEvents = False
        dim t as range
        for each t in Intersect(Target, mrng)
            select case lcase(t.value2)
                case "yes"
                    t = vbnullstring
                case else
                    t = "Yes"
            end select
        next t
        Range("A1").Select
    End If

    Application.EnableEvents = True
End Sub