VBA code and merged cells

[jdluke6545]

I am needing a VBA code to unlock cells but when looking for an answer I came across a thread that said VBA and merged cells don't work.
Well I have merged cells and there is no way I can redo the sheet and not have merged cells.
is there any way to get VBA code to play nice with merged cells?
I can post images of my sheet that I need help with VBA code If anyone has a possible solution to this problem first.
Or I can try the XL2BB thing.... never used that before tho....

 

[jolivanes]

Don't know if you still need it or even want it but this is what I use to get rid of the dreaded merge areas.
Very easy to set it up for all sheets in a workbook.

Sub Change_Merged_To_Center_Across()
Dim c As Range
For Each c In ActiveSheet.UsedRange
With c
 If .MergeCells Then
    With .MergeArea
        .UnMerge
        .HorizontalAlignment = xlCenterAcrossSelection
    End With
 End If
End With
Next c
End Sub

And if absolutely required, you can change it back to merged again with similar code.
I would not know why you ever would want to do that though.

 

[Alex Blakenburg]

@jolivanes Sadly we were categorically told unmerging was not option.

Well I have merged cells and there is no way I can redo the sheet and not have merged cells.

 

[jdluke6545]

Hit another little quirk of merged cells.

See if this works for you:-

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngID As Range
    Dim ws As Worksheet
    Dim pwd As String
   
    Set ws = ActiveSheet
    Set rngID = Range(Cells(35, 1), Cells(71, 1))
    pwd = "test"                            ' XXX PASSWORD
   
    If Not Intersect(Target.Cells(1, 1), rngID) Is Nothing Then
       
            If Target.Cells(1, 1).Value = "ST" Or Target.Cells(1, 1).Value = "NT" Then
                ws.Unprotect pwd            ' XXX PASSWORD OFF
                Target.Offset(0, 1).MergeArea.Locked = False
                ws.Protect pwd              ' XXX PASSWORD ON
               
            ElseIf Target.Offset(0, 1).MergeArea.Locked = False Then
                ws.Unprotect pwd            ' XXX PASSWORD OFF
                Target.Offset(0, 1).MergeArea.Locked = True
                ws.Protect pwd              ' XXX PASSWORD ON
            End If
    End If
End Sub

Ok, I'll give that a try tomorrow. Thank you!!
I am brain fried for the day.....

 

[jdluke6545]

Don't know if you still need it or even want it but this is what I use to get rid of the dreaded merge areas.
Very easy to set it up for all sheets in a workbook.

Sub Change_Merged_To_Center_Across()
Dim c As Range
For Each c In ActiveSheet.UsedRange
With c
 If .MergeCells Then
    With .MergeArea
        .UnMerge
        .HorizontalAlignment = xlCenterAcrossSelection
    End With
 End If
End With
Next c
End Sub

And if absolutely required, you can change it back to merged again with similar code.
I would not know why you ever would want to do that though.

jolivanes​

I totally understand your thoughts about merged cells but I posted a link in a earlier post to drop box with the sheet and you can see why I need merged cells.

 

[jolivanes]

Alex & *jdluke6545
There is always future possibilities. As we have all seen, this crops up on a regular basis.

 

[jdluke6545]

Hit another little quirk of merged cells.

See if this works for you:-

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngID As Range
    Dim ws As Worksheet
    Dim pwd As String
   
    Set ws = ActiveSheet
    Set rngID = Range(Cells(35, 1), Cells(71, 1))
    pwd = "test"                            ' XXX PASSWORD
   
    If Not Intersect(Target.Cells(1, 1), rngID) Is Nothing Then
       
            If Target.Cells(1, 1).Value = "ST" Or Target.Cells(1, 1).Value = "NT" Then
                ws.Unprotect pwd            ' XXX PASSWORD OFF
                Target.Offset(0, 1).MergeArea.Locked = False
                ws.Protect pwd              ' XXX PASSWORD ON
               
            ElseIf Target.Offset(0, 1).MergeArea.Locked = False Then
                ws.Unprotect pwd            ' XXX PASSWORD OFF
                Target.Offset(0, 1).MergeArea.Locked = True
                ws.Protect pwd              ' XXX PASSWORD ON
            End If
    End If
End Sub

Oh, I think we are so close.
It does work when I click on one cell and hit delete, but not when you select and highlight a range of cells and hit delete.
I found this out when I ran my other macro to clear the sheet. That other macro was created by recording a macro and I clicked and selected the whole ID column and hit delete.
Then saved that macro recording and linked a button to it.
This time the error message:

Run-time error '1004':
Application-defined or object-defined error

and the line that in VBA that was highlighted:

ElseIf Target.Offset(0, 1).MergeArea.Locked = False Then

Just so close......

 

[jdluke6545]

Alex & *jdluke6545
There is always future possibilities. As we have all seen, this crops up on a regular basis.

I would be interested in knowing what "future possibilities" you are referring to...

 

[jolivanes]

In the future you just might end up with a workbook again that has merged cells in one or more of it's sheets.
By that time you also might have experienced the pitfalls of merged cells more often and you could than see if there is a possibility to change to Center Across Selection.
And guess what. You remember this thread and also remember that you have the right tools to fix the problem.
If not, no problem. Just forget the whole thing.

 

[jdluke6545]

In the future you just might end up with a workbook again that has merged cells in one or more of it's sheets.
By that time you also might have experienced the pitfalls of merged cells more often and you could than see if there is a possibility to change to Center Across Selection.
And guess what. You remember this thread and also remember that you have the right tools to fix the problem.
If not, no problem. Just forget the whole thing.

jolivanes​

Thanks, and I appreciate your input, but Center Across Selection will not work for my needs in this sheet.
In order to get the layout that I need, I have to have merged cells.

 

[Alex Blakenburg]

Oh, I think we are so close.
It does work when I click on one cell and hit delete, but not when you select and highlight a range of cells and hit delete.
I found this out when I ran my other macro to clear the sheet. That other macro was created by recording a macro and I clicked and selected the whole ID column and hit delete.
Then saved that macro recording and linked a button to it.

This should handle a range of cells being changed.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngID As Range
    Dim ws As Worksheet
    Dim pwd As String
    Dim rngIntersect As Range
    Dim cellIntersect As Range
    
    Set ws = ActiveSheet
    Set rngID = Range(Cells(35, 1), Cells(71, 1))
    Set rngIntersect = Intersect(Target, rngID)
    pwd = "test"                            ' XXX PASSWORD
    
    If Not rngIntersect Is Nothing Then
        For Each cellIntersect In rngIntersect
        
            If cellIntersect.Cells(1, 1).Value = "ST" Or cellIntersect.Cells(1, 1).Value = "NT" Then
                ws.Unprotect pwd            ' XXX PASSWORD OFF
                cellIntersect.Offset(0, 1).MergeArea.Locked = False
                ws.Protect pwd              ' XXX PASSWORD ON
                
            ElseIf cellIntersect.Offset(0, 1).MergeArea.Locked = False Then
                ws.Unprotect pwd            ' XXX PASSWORD OFF
                cellIntersect.Offset(0, 1).MergeArea.Locked = True
                ws.Protect pwd              ' XXX PASSWORD ON
            End If
        Next cellIntersect
    End If
End Sub