Results 1 to 6 of 6
  1. #1
    Lounger
    Join Date
    Sep 2013
    Posts
    34
    Thanks
    16
    Thanked 0 Times in 0 Posts

    Merge/Unmerge cell automatically depending on the value

    Hello friends
    I have an situation:

    I have an area in a worksheet B15;Q15
    - every cell in from area are data validation type from column S
    - If in every cell I select value X or Z or T I want active cell and next cell to right to be merge cell and show me what value I selected ( I dont want that more than 2 cell to be merge)

    If in the merge cell I select 1 ,2 or 3 the merge cell I want to be unmerge and show me what value I selected

    i hope i was explicit
    Attached Files Attached Files

  2. #2
    Lounger
    Join Date
    Sep 2013
    Posts
    34
    Thanks
    16
    Thanked 0 Times in 0 Posts

    re

    I found something on the internet, i tried to edit it but it works only for a single value and a single conditon merge or unmerge cell. i wish that to de done in the same vba. I attached the vba code in idea that can help you and make it easier.
    Thanks in advance
    Code:
    'unmerge
    Option Explicit
    Private Sub Worksheet_Change(ByVal ActiveCell As Range)
    On Error GoTo exitHandler
    Dim rngDV As Range
    If ActiveCell.Count > 1 Then GoTo exitHandler
    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler
    If rngDV Is Nothing Then GoTo exitHandler
     ' If ActiveCell.MergeCells = True Then GoTo exitHandler ' daca activecell este merge atunci nu merge macro
    If Intersect(ActiveCell, rngDV) Is Nothing Then
       'do nothing
    Else
      Application.EnableEvents = False
         If ActiveCell.Value = "" Then GoTo exitHandler
         If ActiveCell.Value = "8" Then
         ActiveCell.Select
          With Selection
                    .VerticalAlignment = xlCenter
                    .WrapText = False
                    .Orientation = 0
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .MergeCells = False
                End With
               Else
            MsgBox "Valoare gresita"
          ActiveCell.Activate
       End If
       End If
    exitHandler:
      Application.EnableEvents = True
      
    End Sub
    Code:
    'merge
    Option Explicit
    Private Sub Worksheet_Change(ByVal ActiveCell As Range)
    On Error GoTo exitHandler
    
    Dim rngDV As Range
    
    If ActiveCell.Count > 1 Then GoTo exitHandler
    
    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler
    If rngDV Is Nothing Then GoTo exitHandler
      If ActiveCell.MergeCells = True Then GoTo exitHandler ' daca activecell este merge atunci nu merge macro
    If Intersect(ActiveCell, rngDV) Is Nothing Then
       'do nothing
    Else
      Application.EnableEvents = False
         If ActiveCell.Value = "" Then GoTo exitHandler
         If ActiveCell.Value = "X" Then
          Range(ActiveCell, ActiveCell.Offset(0, 1)).Select
                Selection.Merge True
        Else
          MsgBox "Invalid entry"
          ActiveCell.Activate
       End If
       End If
    exitHandler:
      Application.EnableEvents = True
    
    End Sub

  3. #3
    Lounger
    Join Date
    Sep 2013
    Posts
    34
    Thanks
    16
    Thanked 0 Times in 0 Posts
    Any solutions? It is not posible what I ask?

  4. #4
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    You need to be a little patient. You post on a Saturday of a Holiday weekend in the US and many of us had family and activities going on. Try adding this code to the worksheet object:

    I only went to the P column, otherwise if you select something from Q3:Q15 it would merge with R or add validation to the R column...

    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
      If Not Intersect(Target, Range("B3:P15")) Is Nothing Then
        Select Case Target.Value
          Case "X", "Z", "T"
            Target.Resize(1, 2).MergeCells = True
          Case 1, 2, 3
            Target.MergeCells = False
            With Target.Resize(1, 2).Validation
              .Delete
              .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Operator:=xlBetween, Formula1:="=$S$1:$S$6"
              .IgnoreBlank = True
              .InCellDropdown = True
              .InputTitle = ""
              .ErrorTitle = ""
              .InputMessage = ""
              .ErrorMessage = ""
              .ShowInput = True
              .ShowError = True
            End With
        End Select
      End If
    End Sub
    Steve

  5. The Following User Says Thank You to sdckapr For This Useful Post:

    afm1985 (2014-05-27)

  6. #5
    Lounger
    Join Date
    Sep 2013
    Posts
    34
    Thanks
    16
    Thanked 0 Times in 0 Posts
    Thanks for reply sdckapr. I didn`t know it was Holiday weekend in USA., It`s working great. If i will want to "improve" the vba i will ask you !!

  7. #6
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    You are welcome. you may want to step through the code to ensure you understand what it all does...

    Steve

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •