Rectangle graph

**Jan Rennel** · 01-11-2014, 08:51 AM

Hi,

I would like to develop an xy-graph consisting of coloured rectangles close to each other.

The basic data are:

Label   x       y      x_cumulative
A        10      5      10
B        35      3      45
C        20      8      65
D        15      4      80
E        20      9     100

The x-values represent per cent and the cumulative sum equals 100. The x_cumulative values represent the x-axis in the graph.
y and x_cumulative values make up the rectangles, in this case 5.
The rectangles are labelled inside the box and would have different colours.
The graph should have a secondary y-axis with the same appearance as the primary y-axis.

I started the programming but came only a small bit.

Sub MakeRectangle()
'
    Dim myRange As Range
    Dim myChart As Chart
    Dim myPoint As Point
    Dim myData As Range
    Dim mySeries As Series
    
    ActiveSheet.Select
    Cells.Item(1, 1).Select
    
    Set myRange = ActiveCell.CurrentRegion
    Set myRange = Intersect(myRange, myRange.Offset(1, 1))
    Set myChart = ActiveSheet.ChartObjects.Add(100, 50, 300, 150).Chart


End Sub

Kind regards,

Jan

**Andy Pope** · 01-12-2014, 07:25 AM

Are you after something like this?
http://www.andypope.info/charts/colwidth.htm

**Jan Rennel** · 01-12-2014, 11:33 AM

Hi Andy,

It is almost what I am looking for.

However, I want to have an x-axis going from 0 to 100.
Besides, I would appreciate a secondary y-axis with the same appearance as the primary one.

The row with the values 20%, 15%, 12%, 30% etc. from the shown graph can be kept, because there I would like to show the the real x-values, not percentage, from column 2 , i.e. 10, 35, 20, 15, 20 in my test table.

Kind regards,

Jan

**Jan Rennel** · 01-14-2014, 06:50 AM

Hi Andy,

Do you have the VBA-code for the graph linked to your indicated address
http://www.andypope.info/charts/colwidth.htm ?

If so the changes might not be so big to get what I am looking for.

Kind regards,

Jan

**Andy Pope** · 01-14-2014, 07:01 AM

That example does not require any code, so no.

**Jan Rennel** · 01-14-2014, 08:22 AM

Hi Andy,

It is pity that you don't have the code. I have drawn the graph manually, but if you have many graphs of that type it would make it easier if you had a macro.

Kind regards,

Jan

**Jan Rennel** · 01-19-2014, 01:38 PM

Hi,

I have the following table where x-y-values are the coordinates for the corners of in this case 4 rectangles. The x-axis goes from 0 to 100.
I am looking for the VBA macro to create this. The rectangles should be in different colors and labelled A, B, C and D.


Label	x	y	y	y	y
A	0.0	0.0			
	0.0	8.0			
	45.0	8.0			
B	45.0	0.0	0.0		
	45.0		5.0		
	65.0		5.0		
C	65.0		0.0	0.0	
	65.0			3.0	
	80.0			3.0	
D	80.0			0.0	0.0
	80.0				9.0
	100.0			9.0
	100.0			0.0

Can someone help me?

Kind regards,

Jan

**Jan Rennel** · 01-19-2014, 01:47 PM

Hi again,

The data of the two last lines in the example were somewhat displaced. They should be in the last column.

Kind regards,

Jan

**Andy Pope** · 01-20-2014, 04:57 AM

In order to plot the rectangle you will need 5 pairs of xy positions.
To plot a label, assuming the label is center of rectangle you will need another 2 pairs of values. The first would contain no value the second the center point of the rectangle.

The reason for the non value pair is to cause a break in the line between rectangle and label point.

Sub Test()

    Dim chtTemp As Chart
    Dim rngDataX As Range
    Dim rngDataY As Range
    
    Set rngDataX = Range("A2:A8")
    Set rngDataY = rngDataX.Offset(0, 1)
    Set chtTemp = ActiveSheet.Shapes.AddChart.Chart
    With chtTemp
        Do While .SeriesCollection.Count > 0
            .SeriesCollection(1).Delete
        Loop
        .ChartType = xlXYScatterLines
        Do While rngDataX.Cells(1, 1).Offset(0, -1) <> ""
            With .SeriesCollection.NewSeries
                .Name = rngDataX.Cells(1, 1).Offset(0, -1)
                .Values = rngDataY
                .XValues = rngDataX
                With .Points(.Points.Count)
                    .HasDataLabel = True
                    With .DataLabel
                        .Position = xlLabelPositionCenter
                        .ShowValue = False
                        .ShowCategoryName = False
                        .ShowSeriesName = True
                    End With
                End With
                .MarkerStyle = xlNone
            End With
            Set rngDataX = rngDataX.Offset(rngDataX.Rows.Count)
            Set rngDataY = rngDataY.Offset(rngDataY.Rows.Count, 1)
        Loop
        With .Axes(xlValue, xlPrimary)
            .MajorGridlines.Delete
            .MinimumScale = 0
            .MaximumScale = 100
        End With
        With .Axes(xlCategory)
            .MajorGridlines.Delete
            .MinimumScale = 0
            .MaximumScale = 100
        End With
    
        With .SeriesCollection.NewSeries
            .AxisGroup = 2
        End With
        With .Axes(xlValue, xlSecondary)
            .MajorGridlines.Delete
            .MinimumScale = 0
            .MaximumScale = 100
        End With
    End With
End Sub

**Jan Rennel** · 01-20-2014, 08:10 AM

Hi Andy,

I tried to use the macro you wrote but it did not function for me. I suppose the reason is that I do not know exactly how the new basic table should look like. Could you please rewrite my table with your changes so it will function. Your statement Range ("A2:A8") looks curious to me. Is it the values for a single rectangle including the label?

I have not been able to really test the macro but when I read it I cannot see anything about colors of the rectangles. Will the rectangles have different colors?

Kind regards,

Jan

**Andy Pope** · 01-20-2014, 08:12 AM

I thought I had attached example file, apparently not

**Jan Rennel** · 01-20-2014, 10:25 AM

Hi again Andy,

I think I have found the error. I changed Range("A2:A8") to Range("C2:C8") and the program now runs properly.

But I have still a question. How to get the rectangles colored, not only the borders?

Kind regards,

Jan

**Jan Rennel** · 01-20-2014, 10:07 AM

Hi Andy,

I have copied your Excel-file with the basic data. When I run the macro I get the message "Application defined or object defined error". The program indicates that the statement "Do while rngDataX.Cells(1, 1).Offset(0, -1) <> " is not correct. What do you say?

I do not understand the statement Set rngDataX = Range("A2:A8"). Are we then not outside the data of the Excel sheet? Column "A" is a data empty column if I have understood you right.

Kind regards,

Jan

**Andy Pope** · 01-20-2014, 10:22 AM

change it to

Set rngDataX = Range("B2:B8")

**Andy Pope** · 01-20-2014, 10:29 AM

*** explained in the example are mentioned at the start. In order to fill the rectangles you need to use column charts with x axis as dates.

**Jan Rennel** · 01-20-2014, 04:35 PM

Hi Andy,

Thank you for all your help. Now, the macro functions properly except that I had hoped to get rectangles filled with different colors. Not only borders in different colors.

How can the x-y-diagram be changed to column charts to make this possible?

Kind regards,

Jan

**Andy Pope** · 01-21-2014, 04:27 AM

Combination area/line chart

Sub VariWidthColumns()
'
    Dim rngData As Range
    Dim lngIndex As Long
    
    Set rngData = Range("C2:K16")
    With ActiveSheet.Shapes.AddChart.Chart
        .ChartType = xlArea
        .SetSourceData Source:=rngData
    
        For lngIndex = 5 To 8
            With .SeriesCollection(lngIndex)
                .ChartType = xlLine
                .AxisGroup = 2
                .HasDataLabels = True
                With .DataLabels
                    .ShowValue = False
                    .ShowSeriesName = True
                    .ShowCategoryName = False
                    .Position = xlLabelPositionAbove
                End With
            End With
        Next
        .Axes(xlValue).MajorGridlines.Delete
        With .Axes(xlCategory)
            .CategoryType = xlTimeScale
            .MaximumScale = 100
            .MajorUnit = 10
            .AxisBetweenCategories = False
        End With
        .DisplayBlanksAs = xlNotPlotted
    End With
End Sub

**Jan Rennel** · 01-21-2014, 06:58 PM

Hi Andy,

I have tried to edit the y-axis and "Major gridlines" somewhat but with little success.

To improve the appearance of the rectangles I have also tried to add a thin, black border around them but I am uncertain of the VBA code.

Kind regards,

Jan

**Andy Pope** · 01-22-2014, 04:23 AM

Sub VariWidthColumns()
'
    Dim myChart As Chart
    Dim rngData As Range
    Dim lngIndex As Long
    
    Set rngData = Range("A1:M15")
    Set myChart = ActiveSheet.ChartObjects.Add(650, 30, 620, 410).Chart
   
    With myChart
        .ChartType = xlArea
        .SetSourceData Source:=rngData
    
        For lngIndex = 1 To 4
            With .SeriesCollection(lngIndex)
                With .Format.Line
                    .Weight = 1
                    .Visible = True
                    .ForeColor.RGB = 0 ' black
                End With
            End With
        Next
    
        For lngIndex = 5 To 12
            With .SeriesCollection(lngIndex)
                .ChartType = xlLine
                .AxisGroup = 2
                .HasDataLabels = True
                With .DataLabels
                    .ShowValue = False
                    .ShowSeriesName = True
                    .ShowCategoryName = False
                    .Position = xlLabelPositionAbove
                    .Font.Bold = True
                    .Font.Size = 7.5
                End With
            End With
        Next
        
        With .Axes(xlCategory)
            .CategoryType = xlTimeScale
            .MaximumScale = 100
            .MajorUnit = 10
            .MinorUnit = 5
            .MinorTickMark = xlOutside
            .AxisBetweenCategories = False
            .Format.Line.Weight = 2.25
            .HasTitle = True
            .AxisTitle.Text = "Share of total, %"
        End With
    
        With myChart.Axes(xlValue, xlPrimary)
            .HasMajorGridlines = True
            .MajorGridlines.Border.LineStyle = x1Dash
            .MinimumScale = 0
            .MaximumScale = 10
            .MajorUnit = 1
            .MinorUnit = 0.5
            .MinorTickMark = xlOutside
            .Format.Line.Weight = 2.25
            With .TickLabels
                 .NumberFormat = "# ##0"
                 .Font.Bold = True
            End With
            .HasTitle = True
            .AxisTitle.Text = "Value Axis"
        End With
    
        .DisplayBlanksAs = xlNotPlotted
        .Legend.Delete
    End With
    
End Sub

**Jan Rennel** · 01-22-2014, 08:19 AM

Hi Andy,

I have tried to develop the graph further but with little success.

1. Major gridlines should be dotted or dashed but have disappeared completely.

2. A dotted red line representing the average y-values with the label "Average" in red should be added. (Red data in the data sheet).

3. A new set of labels (AAAA, BBBB, CCCC, DDDD) have been added but they do not seem to have been included in the graph. Is the location of the graph influencing the data of the cells? The graph covers some of the data.

Kind regards,

Jan

**Andy Pope** · 01-22-2014, 08:35 AM

Sub VariWidthColumns()
'
    Dim myChart As Chart
    Dim rngData As Range
    Dim lngIndex As Long
    Dim zz As Series
    
    Set rngData = Range("A1:N15")
    Set myChart = ActiveSheet.ChartObjects.Add(650, 30, 620, 410).Chart
   
    With myChart
        .ChartType = xlArea
        .SetSourceData Source:=rngData
    
        For lngIndex = 1 To 4
            With .SeriesCollection(lngIndex)
                With .Format.Line
                    .Weight = 1
                    .Visible = True
                    .ForeColor.RGB = 0 ' black
                End With
            End With
        Next
    
        With .SeriesCollection(5)
            .ChartType = xlLine
            With .Format.Line
                .Weight = 1
                .Visible = True
                .ForeColor.RGB = 255 ' red
                .DashStyle = msoLineDash
            End With
            With .Points(1)
                .HasDataLabel = True
                With .DataLabel
                    .ShowValue = False
                    .ShowSeriesName = True
                    .ShowCategoryName = False
                    .Position = xlLabelPositionRight
                    .Font.Bold = True
                    .Font.Size = 10
                    .Font.Color = vbRed
                End With
            End With
        End With
    
        For lngIndex = 6 To 13                  '5 to 12
            With .SeriesCollection(lngIndex)
                .ChartType = xlLine
                .AxisGroup = 2
                .HasDataLabels = True
                With .DataLabels
                    .ShowValue = False
                    .ShowSeriesName = True
                    .ShowCategoryName = False
                    .Position = xlLabelPositionAbove
                    .Font.Bold = True
                    .Font.Size = 7.5
                End With
            End With
        Next
        
        With .Axes(xlCategory)
            .CategoryType = xlTimeScale
            .MaximumScale = 100
            .MajorUnit = 10
            .MinorUnit = 5
            .MinorTickMark = xlOutside
            .AxisBetweenCategories = False
            .Format.Line.Weight = 2.25
            .HasTitle = True
            .AxisTitle.Text = "Share of total, %"
            With .TickLabels
                 .NumberFormat = "# ##0"
                 .Font.Bold = True
            End With
        End With
    
        With myChart.Axes(xlValue, xlPrimary)
            .HasMajorGridlines = True
            .MajorGridlines.Border.LineStyle = xlDash
            .MinimumScale = 0
            .MaximumScale = 10
            .MajorUnit = 1
            .MinorUnit = 0.5
            .MinorTickMark = xlOutside
            .Format.Line.Weight = 2.25
            With .TickLabels
                 .NumberFormat = "# ##0"
                 .Font.Bold = True
            End With
            .HasTitle = True
            .AxisTitle.Text = "Value Axis"
        End With
    
        With myChart.Axes(xlValue, xlSecondary)
            .HasMajorGridlines = True
            .MajorGridlines.Border.LineStyle = x1Dash
            .MinimumScale = 0
            .MaximumScale = 10
            .MajorUnit = 1
            .MinorUnit = 0.5
            .MinorTickMark = xlOutside
            .Format.Line.Weight = 2.25
            With .TickLabels
                 .NumberFormat = "# ##0"
                 .Font.Bold = True
            End With
            .HasTitle = False
            '.AxisTitle.Text = "Value Axis"
        End With
    
        .DisplayBlanksAs = xlNotPlotted
        .Legend.Delete
    End With
    
End Sub

you has x1Dash rather than xlDash. (1 one rather than l L)
you need to change chart type of 5th series to line
those new series data labels are at the top of the chart

**Jan Rennel** · 01-22-2014, 01:18 PM

Hi Andy,

I tried to extend the labels with another series (AAAA, BBBB, CCCC, and DDDD), but then the macro does not seem to function at all. Have you any explanation to this?

Besides, the color of the dotted line representing "average" is still blue, even if the code indicates that the line should be red. Why?

Kind regards,

Jan

**Andy Pope** · 01-23-2014, 09:21 AM

Sub VariWidthColumns()
'
    Dim myChart As Chart
    Dim rngData As Range
    Dim lngIndex As Long
    
    Set rngData = Range("A1:N15")
    Set myChart = ActiveSheet.ChartObjects.Add(650, 30, 620, 410).Chart
   
    With myChart
        .ChartType = xlArea
        .SetSourceData Source:=rngData
    
        For lngIndex = 1 To 4
            With .SeriesCollection(lngIndex)
                With .Format.Line
                    .Weight = 1
                    .Visible = True
                End With
                .Border.Color = 0 ' black
            End With
        Next
    
        With .SeriesCollection(5)
            .ChartType = xlLine
            .Border.Color = 255 ' red
            With .Format.Line
                .Weight = 1
                .Visible = True
                .DashStyle = msoLineDash
            End With
            With .Points(1)
                .HasDataLabel = True
                With .DataLabel
                    .ShowValue = False
                    .ShowSeriesName = True
                    .ShowCategoryName = False
                    .Position = xlLabelPositionRight
                    .Font.Bold = True
                    .Font.Size = 10
                    .Font.Color = vbRed
                End With
            End With
        End With
    
        For lngIndex = 6 To 13                  '5 to 12
            With .SeriesCollection(lngIndex)
                .ChartType = xlLine
                .AxisGroup = 2
                .HasDataLabels = True
                With .DataLabels
                    .ShowValue = False
                    .ShowSeriesName = True
                    .ShowCategoryName = False
                    .Position = xlLabelPositionAbove
                    .Font.Bold = True
                    .Font.Size = 7.5
                End With
            End With
        Next
        
        With .Axes(xlCategory)
            .CategoryType = xlTimeScale
            .MaximumScale = 100
            .MajorUnit = 10
            .MinorUnit = 5
            .MinorTickMark = xlOutside
            .AxisBetweenCategories = False
            .Format.Line.Weight = 2.25
            .HasTitle = True
            .AxisTitle.Text = "Share of total, %"
            With .TickLabels
                 .NumberFormat = "# ##0"
                 .Font.Bold = True
            End With
        End With
    
        With myChart.Axes(xlValue, xlPrimary)
            .HasMajorGridlines = True
            .MajorGridlines.Border.LineStyle = xlDash
            .MinimumScale = 0
            .MaximumScale = 10
            .MajorUnit = 1
            .MinorUnit = 0.5
            .MinorTickMark = xlOutside
            .Format.Line.Weight = 2.25
            With .TickLabels
                 .NumberFormat = "# ##0"
                 .Font.Bold = True
            End With
            .HasTitle = True
            .AxisTitle.Text = "Value Axis"
        End With
    
        With myChart.Axes(xlValue, xlSecondary)
            .HasMajorGridlines = True
            .MajorGridlines.Border.LineStyle = x1Dash
            .MinimumScale = 0
            .MaximumScale = 10
            .MajorUnit = 1
            .MinorUnit = 0.5
            .MinorTickMark = xlOutside
            .Format.Line.Weight = 2.25
            With .TickLabels
                 .NumberFormat = "# ##0"
                 .Font.Bold = True
            End With
            .HasTitle = False
            '.AxisTitle.Text = "Value Axis"
        End With
    
        .DisplayBlanksAs = xlNotPlotted
        .Legend.Delete
    End With
    
End Sub

Charting code between xl2007 and xl2010 is different.

**Jan Rennel** · 01-23-2014, 06:47 PM

Hi Andy,

I have tested the above macro under more realistic conditions. The result is, however, not encouraging.

If you open the attached file "Rectangle_graph -Sheet1" and run the macro "VariWidthColumnsSmall" it functions properly.

If you instead open "Rectangle_graph -Sheet2" and run the macro "VariWidthColumnsLarg" it does not function at all. Do you have any explanation to that? The macros should be the same except that they are adjusted for the number of cells included.

Kind regards,

Jan

**Andy Pope** · 01-24-2014, 04:34 AM

If you remove the x from B1 then Excel will not assume the first column is a series of data rather than category values AND if you change the Minimum scale value from zero to -3, as you data now includes negative values, it will work.

Sub VariWidthColumnsLarg()
'Sub VariWidthColumns()
'
    Dim myChart As Chart
    Dim rngData As Range
    Dim lngIndex As Long
    Dim lngNCols As Long
    
    Set rngData = Range("B1:AA27")                     'kolla antalet celler
    Set myChart = ActiveSheet.ChartObjects.Add(650, 30, 620, 410).Chart
    
    lngNCols = (rngData.Columns.Count - 1) / 3
    
    With myChart
        .ChartType = xlArea
        .SetSourceData Source:=rngData
    
        For lngIndex = 1 To lngNCols                      '1 till 4
            With .SeriesCollection(lngIndex)
                With .Format.Line
                    .Weight = 1
                    .Visible = True
                End With
                .Border.Color = 0 ' black
            End With
        Next
    
        With .SeriesCollection(lngNCols + 1)                    '+1
            .ChartType = xlLine
            .Border.Color = 255 ' red
            With .Format.Line
                .Weight = 1
                .Visible = True
                .DashStyle = msoLineDash
            End With
            With .Points(1)
                .HasDataLabel = True
                With .DataLabel
                    .ShowValue = False
                    .ShowSeriesName = True
                    .ShowCategoryName = False
                    .Position = xlLabelPositionRight
                    .Font.Bold = True
                    .Font.Italic = True
                    .Font.Size = 10
                    .Font.Color = vbRed
                End With
            End With
        End With
    
        For lngIndex = lngNCols + 2 To rngData.Columns.Count - 1              '10 to 13
            With .SeriesCollection(lngIndex)
                .ChartType = xlLine
                .AxisGroup = 2
                .HasDataLabels = True
                With .DataLabels
                    .ShowValue = False
                    .ShowSeriesName = True
                    .ShowCategoryName = False
                    .Position = xlLabelPositionAbove
                    .Font.Bold = True
                    .Font.Size = 7.5
                End With
            End With
        Next
        
        With .Axes(xlCategory)
            .CategoryType = xlTimeScale
            .MaximumScale = 100
            .MajorUnit = 10
            .MinorUnit = 5
            .MinorTickMark = xlOutside
            .AxisBetweenCategories = False
            .Format.Line.Weight = 2.25
            .HasTitle = True
            .AxisTitle.Text = "Share of total, %"
            With .TickLabels
                 .NumberFormat = "# ##0"
                 .Font.Bold = True
            End With
        End With
    
        With myChart.Axes(xlValue, xlPrimary)
            .HasMajorGridlines = True
            .MajorGridlines.Border.LineStyle = xlDash
            .MinimumScale = -3
            .MaximumScale = 10
            .MajorUnit = 1
            .MinorUnit = 0.5
            .MinorTickMark = xlOutside
            .Format.Line.Weight = 2.25
            With .TickLabels
                 .NumberFormat = "# ##0"
                 .Font.Bold = True
            End With
            .HasTitle = True
            .AxisTitle.Text = "Value Axis"
        End With
    
        With myChart.Axes(xlValue, xlSecondary)
            .HasMajorGridlines = True
            .MajorGridlines.Border.LineStyle = x1Dash
            .MinimumScale = -3
            .MaximumScale = 10
            .MajorUnit = 1
            .MinorUnit = 0.5
            .MinorTickMark = xlOutside
            .Format.Line.Weight = 2.25
            With .TickLabels
                 .NumberFormat = "# ##0"
                 .Font.Bold = True
            End With
            .HasTitle = False
            '.AxisTitle.Text = "Value Axis"
        End With
    
        .DisplayBlanksAs = xlNotPlotted
        .Legend.Delete
    End With
    
End Sub

I have also included a variable to automatically calculate the series indexes for various sections of the code.

**Jan Rennel** · 01-24-2014, 10:48 AM

Hi Andy,

I tried to add another series of data to the graph (AB1:AI1) but then the program indicated an Error. Do you have any explanation to that?

Kind regards,

Jan

**Andy Pope** · 01-24-2014, 10:56 AM

Do you bother to see what the code actually generates? You may not know the code to fix the problem but at least you would see the problem.

Because you now have more columns than rows excel switches the expected layout of data. Notice the category axis is no longer numbers but text.

    lngNCols = (rngData.Columns.Count - 1) / 3
    lngNCols = 8
    
    With myChart
        .ChartType = xlArea
        .SetSourceData Source:=rngData
        .PlotBy = xlColumns

So force the chart data layout to be by columns.

Also you will need to alter the lngNCols value so the right series are formatted correctly. For this I have reverted to explicitly setting the value to 8.

**Jan Rennel** · 02-06-2014, 06:49 AM

Hi Andy,

I have got very valuable help from you with the enclosed macro.

I would like to go somewhat further and test the labels: "AA", "BB", "CC" and "DD".

Are some of the labels numbers and if so, are some negative, i.e. less than 0. Then negative numbers shall be in red color instead of black in the graph.

I also wonder if it is possible to choose different color palettes for the graphs? If so, I would like to have somewhat brighter colors than at present.

Kind regards,

Jan

Hybrid View

Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Re: Rectangle graph

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] Code to get a Range RECTangle or PT

Bookmarks

Bookmarks

Posting Permissions