VBA HELP - "If Sheet has no Meged Cells Do Nothing, If Merged Cells then Run Code" Excel 2013

[magnum5az]

Hello All,

I am working on a piece of code that will look at a specific sheet and if there are merged cells present run a code to remove all merged cells and move a header, if no merged cells exist on the sheet then do nothing.

Here is what I've come up with but need the "Case" or "If/Then" code

Sub ReOrgData()

    Dim Sourcesht As Worksheet
    
    Set Sourcesht = Sheets("AR Aging-Combined Property")
    
    
    Sourcesht.Cells.Select
    Selection.UnMerge
    Range("B2:B4").Select
    Selection.Cut
    Range("A2").Select
    ActiveSheet.Paste
    Rows("7:7").Select
    Selection.Delete Shift:=xlUp
    Application.CutCopyMode = False



End Sub

Thanks in advance for any help on this.

 

[JLGWhiz]

Hello All,

I am working on a piece of code that will look at a specific sheet and if there are merged cells present run a code to remove all merged cells and move a header, if no merged cells exist on the sheet then do nothing.

Here is what I've come up with but need the "Case" or "If/Then" code

Sub ReOrgData()

    Dim Sourcesht As Worksheet
    
    Set Sourcesht = Sheets("AR Aging-Combined Property")
    
    
    Sourcesht.Cells.Select
    Selection.UnMerge
    Range("B2:B4").Select
    Selection.Cut
    Range("A2").Select
    ActiveSheet.Paste
    Rows("7:7").Select
    Selection.Delete Shift:=xlUp
    Application.CutCopyMode = False



End Sub

Thanks in advance for any help on this.

You don't really need an If ... Then statement. Just run the code to unmerge and do the work and it will take care of it. If the cells are merged they will unmerge. If they are not merged, vba will ignore the command and move on.

 

[DushiPunda]

You don't really need an If ... Then statement. Just run the code to unmerge and do the work and it will take care of it. If the cells are merged they will unmerge. If they are not merged, vba will ignore the command and move on.

But they do need an If..Then statement...

"if there are merged cells present then run a code to remove all merged cells and move a header"

So, if there are no merged cells, then he doesn't want to move the header.

Without an If..Then, the header will be moved no matter what.

 

[DushiPunda]

Untested, but this should work for you:

Sub ReOrgData()
Dim c As Range
Dim mCells As Boolean
Dim Sourcesht As Worksheet

Set Sourcesht = Sheets("AR Aging-Combined Property")

For Each c In Sourcesht.UsedRange
    If c.MergeCells Then
        mCells = True
        GoTo ExitFor
    End If
Next c

ExitFor:
If mCells Then
    Sourcesht.Cells.UnMerge
    Sourcesht.Range("B2:B4").Cut
    Sourcesht.Range("A2").Select
    Sourcesht.Paste
    Sourcesht.Rows("7:7").Delete Shift:=xlUp
    Application.CutCopyMode = False
End If
End Sub

 

[Rick Rothstein]

But they do need an If..Then statement...

"if there are merged cells present then run a code to remove all merged cells and move a header"

So, if there are no merged cells, then he doesn't want to move the header.

Without an If..Then, the header will be moved no matter what.

You can test if there is at least one merged cells (could be more, lots more) like this...

If IsNull(Sourcesht.Cells.MergeCells) Then

Note: The above line of code assumes at least one cell on the worksheet is not merged (which seems like a reasonanble assumption to me).

 

[magnum5az]

Worked like a charm! Thanks for this!

Untested, but this should work for you:

Sub ReOrgData()
Dim c As Range
Dim mCells As Boolean
Dim Sourcesht As Worksheet

Set Sourcesht = Sheets("AR Aging-Combined Property")

For Each c In Sourcesht.UsedRange
    If c.MergeCells Then
        mCells = True
        GoTo ExitFor
    End If
Next c

ExitFor:
If mCells Then
    Sourcesht.Cells.UnMerge
    Sourcesht.Range("B2:B4").Cut
    Sourcesht.Range("A2").Select
    Sourcesht.Paste
    Sourcesht.Rows("7:7").Delete Shift:=xlUp
    Application.CutCopyMode = False
End If
End Sub

 

[Rick Rothstein]

Worked like a charm! Thanks for this!

Sub ReOrgData()
Dim c As Range
Dim mCells As Boolean
Dim Sourcesht As Worksheet

Set Sourcesht = Sheets("AR Aging-Combined Property")

For Each c In Sourcesht.UsedRange
    If c.MergeCells Then
        mCells = True
        GoTo ExitFor
    End If
Next c

ExitFor:
If mCells Then
    Sourcesht.Cells.UnMerge
    Sourcesht.Range("B2:B4").Cut
    Sourcesht.Range("A2").Select
    Sourcesht.Paste
    Sourcesht.Rows("7:7").Delete Shift:=xlUp
    Application.CutCopyMode = False
End If
End Sub

All of the code above can be replaced by this...

Sub ReOrgData()
  With Sheets("AR Aging-Combined Property")
    If IsNull(.Cells.MergeCells) Then
      .Cells.UnMerge
      .Range("B2:B4").Cut .Range("A2")
      .Rows("7:7").Delete Shift:=xlUp
    End If
  End With
End Sub

 

[magnum5az]

worked great and shortened the code nicely. Thanks

 

[DushiPunda]

Rick,

Shouldn't it be:

If Not IsNull(.Cells.MergeCells) Then

 

[Rick Rothstein]

Rick,

Shouldn't it be:

If Not IsNull(.Cells.MergeCells) Then

No, it is correct as originally written. Cells.MergeCells will return False if no merged cells exist, True if all cells are involved in a merge (a highly, highly unlikely scenario) and Null if the sheet contains a mixture of merged and non-merged cells. Since the mixture of merged and non-merged cells is what we are after (I completely discount a True result as such a sheet would be ridiculous), we need to test if Cells.MergeCells returns Null... IsNull does that (it will return True when MergeCells is Null).