vba to help with merged cells

[dshafique]

Hey guys, I am trying to create a macro which deals with merged cells. The data I deal with comes from a table in powerpoint. when i copy the data over a lot of the cells end up being merged (I'm not sure why, but it's not merged in the ppt). what I want to do is to unmerge all the cells, then append any data that's in the blank lines in between. there are only 2 columns which have data that isnt merged.

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]John Smith[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]email Data[/TD]
[TD]app data[/TD]
[TD]data[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]email data[/TD]
[TD]app data[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]email data[/TD]
[TD]app data[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]john smith[/TD]
[TD]data [/TD]
[TD]data[/TD]
[TD]data[/TD]
[TD]data[/TD]
[TD]data[/TD]
[TD]data[/TD]
[TD]email data[/TD]
[TD]app data[/TD]
[TD]data[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]app data[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

roughly how the table looks after unmerging


basically pseudo code:

1.) select everything
2.) unmerge cells
3.) check name cell to see if it's empty
if empty check if email data column is empty
if email data column is NOT empty, append data to email data cell above
else check app data cell and if NOT empty, append to the cell above.
4.) delete the whole row after

if anyone could give any guidelines that would be greatly appreciated. thanks

 

[kvsrinivasamurthy]

Pl show how the table should be after running macro.

 

[Fluff]

How about

Sub UnMergeCombine()
   Dim Rng As Range
   
   ActiveSheet.UsedRange.MergeCells = False
   For Each Rng In Range("G:G").SpecialCells(xlBlanks).Areas
      Rng.Offset(-1, 1).Resize(1, 1).Value = Join(Application.Transpose(Rng.Offset(-1, 1).Resize(Rng.Count + 1).Value), ", ")
      Rng.Offset(-1, 2).Resize(1, 1).Value = Join(Application.Transpose(Rng.Offset(-1, 2).Resize(Rng.Count + 1).Value), ", ")
   Next Rng
   Range("G:G").SpecialCells(xlBlanks).EntireRow.Delete
End Sub

 

[dshafique]

Thank you @Fluff. this is exactly what I needed!

 

[Fluff]

Glad to help & thanks for the feedback