PDA

View Full Version : Solved: How to delete columns that go through an area with merged cells



Luc
04-20-2010, 12:24 PM
Hello everybody.

I'm working on a macro to automize the creation of a graph. The creation of the graph is no problem.
But now I want to clean up the graph, I want to delete the columns that have no data for the graph in it.
In the range of the X-axis value are merged cells

As the position of the empty columns can change I cannot use the code like

Columns("O:O").Select
I use the code

Columns(legekolom).Select
where 'legekolom' is a reference number for the involved column
With this code not only the referenced column is selected but all the columns that are part of the merged area where the column goes through.

Attached you can find the module of the clean up phase.

Any help is appreciated

Luc

lucas
04-20-2010, 12:36 PM
Unmerge the cells and use center across selection instead.

Merged cells will cause all kinds of headaches like this.

I unmerged yours but I don't have 2007 so it's an xls. Notes in the file.

You should use option explicit at the top of every userform, standard module, etc. It will show errors that you might not know about.

As I said, I didn't test your macro.

Luc
04-20-2010, 12:54 PM
Thanks Lucas, but I want to avoid the unmerging of the cells, because than the different levels of the X-axis are no longer centered with the values.

I've added the file again but now I've included the graph

mdmackillop
04-20-2010, 02:57 PM
No code included, but is this the result you are after?

Luc
04-21-2010, 02:57 AM
Hello MD.

I'm not after the result as you've made it. It should really look as it is in my original graph.

The different points from 1 X-axis member level 2 must be connected only with each other and not with all the points from the other X-axis members
(In this example the points 1 and 2 must be connected ; the points 3, 4 and 5 must be connected; the points 6 and 7 must be connected)

If there is no other alternative I work around the problem by unmerging the different areas and after deleting the involved column merging the different areas again.

Mvg

Luc

Luc
04-22-2010, 02:17 AM
Below you can find the code of my around the problem of deleting columns that go through merged areas.


Public offsetkolom As Integer, legekolom As Integer, resizehoogte As Integer
Public mergewidth2 As Integer, offsetwidth2 As Integer
Public mergewidth3 As Integer, offsetwidth3 As Integer
Public mergewidth4 As Integer, offsetwidth4 As Integer
Public mergewidth5 As Integer, offsetwidth5 As Integer
Sub Lege_kolommen() 'module 4
Dim Controlegetallen() As Variant
Application.ScreenUpdating = False
Worksheets("werkblad").Select
For teller = 1 To Range("Totaal_members").Value
If teller = 1 Then

ReDim Controlegetallen(1 To Range("Members2").Value) 'declares the array variable with the necessary size
For array_teller = 1 To Range("Members2").Value
If array_teller = 1 Then
Set bijkomende_members_cel = Range("Valid_1_2") 'is hier vastgelegd omdat bij volgende arrayteller de cel hieronder moet bijgeteld worden bij aantal
aantal = 1
arraygetal = aantal
Else
Set bijkomende_members_cel = bijkomende_members_cel.Offset(1, 0)
aantal = aantal + bijkomende_members_cel.Value
arraygetal = aantal
End If
Controlegetallen(array_teller) = arraygetal
Next array_teller
Else
End If

offsetkolom = Range("Totaal_members").Value - teller
legekolom = Range("Totaal_members").Value - teller + 3

resizehoogte = Range("Datarijen").Value * Range("Aantal_Features").Value
Set lege_kolom_gebied = Range("grafiekdata").Offset(0, offsetkolom).Resize(resizehoogte, 1) 'grafiekdata refers to cell C24
lege_kolom_gebied.Select
If Application.WorksheetFunction.Count(lege_kolom_gebied) = 0 Then

If Range("Valid_1_2").Value = "Yes" Then 'Valid_1_2 refers to cel B13
If (offsetkolom + 1) Mod Range("Members1").Value = 1 Then
GoTo lastline:
Else
Call Unmerge_area
Columns(legekolom).Select
Selection.Delete
Call Merge_area
End If
Else
niet_gelijk_aan_getal_array = 0
For i = 1 To UBound(Controlegetallen) 'columns can only be removed when they are not the first column of an merged area
If Controlegetallen(i) = (offsetkolom + 1) Mod Range("Members1").Value Then
GoTo lastline:
Else
End If
Next i

Call Unmerge_area
Columns(legekolom).Select
Selection.Delete
Call Merge_area
lastline:
End If
Else
End If

If teller = Range("Totaal_members").Value Then
Erase Controlegetallen() 'array leeg maken
Else
End If
Next teller
End Sub
Sub Unmerge_area()
Dim startcel As Range
Application.ScreenUpdating = False
Set startcel = Range("grafiekdata").Offset(0, offsetkolom)
For teller = 2 To Range("Aantal_Levels").Value
Select Case teller
Case 2
startcel.Offset(-2, 0).Select
mergewidth2 = Selection.Cells.Count - 1
Selection.UnMerge
offsetwidth2 = ActiveCell.Column - (legekolom - 1)

Case 3
startcel.Offset(-3, 0).Select
mergewidth3 = Selection.Cells.Count - 1
Selection.UnMerge
offsetwidth3 = ActiveCell.Column - (legekolom - 1)

Case 4
startcel.Offset(-4, 0).Select
mergewidth4 = Selection.Cells.Count - 1
Selection.UnMerge
offsetwidth4 = ActiveCell.Column - (legekolom - 1)

Case 5
startcel.Offset(-5, 0).Select
mergewidth5 = Selection.Cells.Count - 1
Selection.UnMerge
offsetwidth5 = ActiveCell.Column - (legekolom - 1)

End Select
Next teller
End Sub
Sub Merge_area()
Set startcel = Range("grafiekdata").Offset(0, (offsetkolom - 1))
Application.ScreenUpdating = False
For teller = 2 To Range("Aantal_Levels").Value
Select Case teller
Case 2
startcel.Offset(-2, offsetwidth2).Resize(1, mergewidth2).Select
Selection.Merge

Case 3
startcel.Offset(-3, offsetwidth3).Resize(1, mergewidth3).Select
Selection.Merge

Case 4
startcel.Offset(-4, offsetwidth4).Resize(1, mergewidth4).Select
Selection.Merge

Case 5
startcel.Offset(-5, offsetwidth5).Resize(1, mergewidth5).Select
Selection.Merge
End Select
Next teller
End Sub