MACRO - Unmerge cells and delete blank columns, leaving data colum

[Guest]

Hello,

I am pulling out of Business Objects reports in excel, unfortunately the
reports come out almost normal. By abnormal I mean thet the various cells of
data are made of several merged columns. I need to write a macro to
automatically unmerge all cells in the sheet and then remove all blank
columns, leaving only the columns with data. As you all know, when unmerging
you get 1 column with the data (the 1st column) then the rest of the columns
of the merge remain blank, those I need to have removed - in an automatical
manner.
I did manage to find over the internet a macro which partially solves my
problem, but with a twist: instead of deleting the blank column it just
copies the data from the 1st cell to the rest (unerged cells). See the code
below. If anyone has any idea on how to modify this macro or a whole
different solution please assist / help me.

Sub TestUnmerge3()
Dim i As Long, n As Long
ReDim ay(1, 0)

With ActiveSheet.UsedRange
For i = 1 To .Count
If .Cells(i).MergeArea.Count > 1 Then
If .Cells(i) <> "" Then ' And .Cells(i).HasFormula = False '?
n = n + 1
ReDim Preserve ay(1, n)
ay(0, n) = .Cells(i).MergeArea.Address

ay(1, n) = .Cells(i).Value

End If
End If
Next
..UnMerge
End With
For i = 1 To n
Range(ay(0, i)).Value = ay(1, i)
Next
End Sub

 

[Jim Cone]

Sub DDD()
Dim lngN As Long
Dim lngCol As Long

Cells.UnMerge
With ActiveSheet.UsedRange
lngCol = .Columns(.Columns.Count).Column
End With
For lngN = lngCol To 1 Step -1
If Application.CountA(Columns(lngN)) = 0 Then
Columns(lngN).Delete
End If
Next
End Sub
-----------
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Alex Sander" <Alex
(e-mail address removed)>
wrote in message
Hello,
I am pulling out of Business Objects reports in excel, unfortunately the
reports come out almost normal. By abnormal I mean thet the various cells of
data are made of several merged columns. I need to write a macro to
automatically unmerge all cells in the sheet and then remove all blank
columns, leaving only the columns with data. As you all know, when unmerging
you get 1 column with the data (the 1st column) then the rest of the columns
of the merge remain blank, those I need to have removed - in an automatical
manner.
I did manage to find over the internet a macro which partially solves my
problem, but with a twist: instead of deleting the blank column it just
copies the data from the 1st cell to the rest (unerged cells). See the code
below. If anyone has any idea on how to modify this macro or a whole
different solution please assist / help me.

Sub TestUnmerge3()
Dim i As Long, n As Long
ReDim ay(1, 0)

With ActiveSheet.UsedRange
For i = 1 To .Count
If .Cells(i).MergeArea.Count > 1 Then
If .Cells(i) <> "" Then ' And .Cells(i).HasFormula = False '?
n = n + 1
ReDim Preserve ay(1, n)
ay(0, n) = .Cells(i).MergeArea.Address

ay(1, n) = .Cells(i).Value

End If
End If
Next
..UnMerge
End With
For i = 1 To n
Range(ay(0, i)).Value = ay(1, i)
Next
End Sub

 

[Guest]

HI,

1st thanks-a-lot for the fast response. Unfortunately it doesn't work ;( It
unmerges but doesn't delete blank columns and further more it seems that it
deletes some of the data columns!
Thanks anyways,

Have a great day,


Alex Sander

 

[Jim Cone]

I would guess that the "blank" columns are not blank.
You should check the sheet after the UnMerge but before any column
deletion to see if "seems" applies at that point.
--
Jim Cone
San Francisco, USA
http://www.officeletter.com/blink/specialsort.html


"Alex Sander"
<[email protected]>
wrote in message
HI,
1st thanks-a-lot for the fast response. Unfortunately it doesn't work ;( It
unmerges but doesn't delete blank columns and further more it seems that it
deletes some of the data columns!
Thanks anyways,
Have a great day,
Alex Sander

 

[Guest]

If you agree I can maybe send you an e-mail with the actual file!
Thanks


Alex

 

[Jim Cone]

Please ...
virus scan the file.
provide the details of what you are trying to do.
explain the purpose of the file
provide your location

Remove XXX from my email address and send the file.
Jim Cone
San Francisco, USA


"Alex Sander"
<[email protected]>
wrote in message
If you agree I can maybe send you an e-mail with the actual file!
Thanks
Alex